Save range as picture

[YasserKhalil]

Hello everyone
I have found this code that is supposed to save range as picture

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub SaveLogoAsGif()
    Dim MyChart     As Chart
    Dim objPict     As Object
    Dim RgCopy      As Range


    On Error Resume Next
        Set RgCopy = Application.InputBox("Select The Range To Copy / Save As", "Selection Save", Selection.Address, Type:=8)
        If RgCopy Is Nothing Then Exit Sub
    On Error GoTo 0


    RgCopy.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    ActiveSheet.PasteSpecial Format:="Bitmap"
    Set objPict = Selection


    With objPict
        .CopyPicture 1, 1
        Set MyChart = ActiveSheet.ChartObjects.Add(1, 1, .Width + 8, .Height + 8).Chart
    End With


    With MyChart
        .Paste
        .Export ThisWorkbook.Path & Application.PathSeparator & "Temp.gif"
        .Parent.Delete
    End With


    objPict.Delete
    Set RgCopy = Nothing
    Set objPict = Nothing


    ShellExecute 0, vbNullString, ThisWorkbook.Path & Application.PathSeparator & "Temp.gif", vbNullString, vbNullString, vbMaximizedFocus
End Sub

It exports the picture but it is blank .. Any ideas?

 

[YasserKhalil]

Any help in this topic please?