YasserKhalil
Well-known Member
- Joined
- Jun 24, 2010
- Messages
- 852
Hello everyone
I have found this code that is supposed to save range as picture
It exports the picture but it is blank .. Any ideas?
I have found this code that is supposed to save range as picture
Code:
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?