Option Explicit



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 / Saveas", "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 ':=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



'// cleanup

objPict.Delete

Set RgCopy = Nothing

Set objPict = Nothing



'// Now lets View it

ShellExecute 0, vbNullString, ThisWorkbook.Path & Application.PathSeparator & "Temp.gif", _

    vbNullString, vbNullString, vbMaximizedFocus



End Sub