Chart export saves a watermark instead of image when picture inserted into Worksheet using VBA

[morsagmon]

Hi all.

I want to save a picture (shape) from my Worksheet as a file, using VBA.
When I manually insert the picture into the Worksheet and name it - all works perfect.
When I use VBA to insert the picture and name it - instead of saving the image, the resulting file is a picture of a grey watermark I have no idea where it was invented.
See my comments in code that wraps the VBA section that causes this.

Sub TestChartExport()


    'IF THIS PICTURE INSERT IS DONE MANUALLY - ALL WORKS FINE
    Dim strPicturePath As String
    strPicturePath = "C:\Users\morsa\Documents\Personal\Career & Personal Development\Sigmatek-IS\Marketing\Branding\Media\LinkedIn_Icon_dark_bg.JPG"
    ThisWorkbook.Worksheets("Sheet1").Pictures.Insert(strPicturePath).Select
    Selection.Name = "LogoImage"
    'END OF AUTOMATIC SECTION THAT "HIDES" THE EXPORTED PICTURE WITH A WATERMARK PICTURE


    Dim strResult As String
    strResult = SaveImageAsFile("Sheet1", "LogoImage")
    Debug.Print (strResult)
End Sub




Function SaveImageAsFile(strSheetName As String, strShapeName As String) As String
'Saves strShapeName that is on strSheetName on current application folder and returns the full path and filename


     Dim MyChart As String
     Dim PicWidth As Long, PicHeight As Long
     Dim strFullFileName As String


     Application.ScreenUpdating = False
     On Error GoTo FailedSave
     
     strFullFileName = Application.ActiveWorkbook.Path & "\LogoImage.jpg"
     
     Worksheets(strSheetName).Shapes.Range(Array(strShapeName)).Select
     With Selection
           PicHeight = .ShapeRange.Height
           PicWidth = .ShapeRange.Width
     End With


     Charts.Add
     ActiveChart.Location Where:=xlLocationAsObject, Name:=strSheetName
     Selection.Border.LineStyle = 0
     MyChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)


     With Worksheets(strSheetName)
           With .Shapes(MyChart)
                 .Width = PicWidth
                 .Height = PicHeight
           End With


           .Shapes(strShapeName).Copy


           With ActiveChart
                 .ChartArea.Select
                 .Paste
           End With
    
           .ChartObjects(1).Chart.Export Filename:=strFullFileName, Filtername:="jpg"
           .Shapes(MyChart).Delete
     End With
     SaveImageAsFile = strFullFileName
CloseSub:
     Application.ScreenUpdating = True
     Exit Function
FailedSave:
    SaveImageAsFile = ""
    GoTo CloseSub
End Function

 

[Domenic]

Try using Shapes.AddPicture instead...

ThisWorkbook.Worksheets("Sheet1").Shapes.AddPicture . . .

 

[morsagmon]

Thanks Domenic.
That workaround works. I guess another of those Excel 2016 glitches...

 

[Domenic]

Thanks Domenic.

You're welcome!

That workaround works. I guess another of those Excel 2016 glitches...

Actually, I think the bug affects Excel 2010 and later versions.