Port vba .SavePicture from Word and VS to Excel as the present exporting/saving of pieces of the spreadsheet including any artwork is absolutely cumbersome.
Dim pic As IPictureDisp
Set pic = myForm.Image1.Picture
stdole.SavePicture pic, "C:\myfile.jpg"
This is how a working example looks at present in Excel 365 to get any piece of the screen/object to an an image file:
Public Const BaseP As String = "WbkLoc" 'Dir where file is stored, in BaseP constant
Private Sub ExportSummary() 'chg 30.06.2017, see if Specials subfolder exists, else create.
Dim fso As Object, area As Object 'add 18.06.2017
Set fso = CreateObject("Scripting.FileSystemObject") 'add 18.06.2017
If Len(Dir(Range(BaseP), vbDirectory)) = 0 Then 'add 18.06.2017
fso.CreateFolder Range(BaseP) 'add 18.06.2017
End If 'add 18.06.2017
Set area = Range("ActiveSparks") 'sALL.Shapes("ActiveSparks1") 'disab 30.06.2017
area.CopyPicture xlScreen, xlBitmap 'disab 30.06.2017
Call OpenPaint(Range(BaseP) & "ActiveData.Png")
Run "TimeStamp", "Export" 'inserts execution time below export summary button.
Public Function OpenPaint(strFile$) 'ver 18.06.2017 need to figure out how to catch error if file does not exist yet
10 Dim paintID$, WshShell As Object: Set WshShell = CreateObject("WScript.Shell")
20 Dim ObjFso As Object, CheckExists As Boolean
30 Set ObjFso = CreateObject("Scripting.FileSystemObject")
40 CheckExists = ObjFso.FileExists(strFile)
50 Select Case CheckExists
60 paintID = Shell("mspaint.exe " & Chr(34) & strFile & Chr(34), vbNormalFocus) 'open app through Shell call, _
concatenation of app + path in quotes (needed due spaces in path), use only 1 or 9, newly opened, existing opened.
70 Case False
80 paintID = Shell("mspaint.exe ", vbNormalFocus) 'code 1
90 End Select
100 Application.Wait Now + TimeValue("00:00:02") ' VBA does all timing in whole seconds
110 With WshShell 'Call Windows Scripting and pass keystrokes per below, with delays
120 .SendKeys "^(v)" 'paste
130 Application.Wait Now + TimeValue("00:00:01") ' VBA does all timing in whole seconds
140 Select Case CheckExists
150 .SendKeys "^(s)" 'save file - needs to cater for language of interface as set by user
160 Case False
170 .SendKeys "%Fav" 'save file as - needs to cater for language of interface as set by user
180 .SendKeys strFile 'paste filename
190 .SendKeys "%S"
200 End Select
210 Application.Wait Second(Now) + 0 'A different way to set a wait-state, DoEvents would do here to.
220 .SendKeys "%Fx" 'open file menu, combined %(F) and eXit into %Fx, no waits needed - 18-9-2016
230 End With 'WshShell