Saving ranges as GIFs

[Ben]

Sub SaveChartAsGIF()
Fname = ThisWorkbook.Path & "\" & ActiveChart.Name & ".gif"
ActiveChart.Export Filename:=Fname, FilterName:="GIF"
End Sub

I'd like to adapt the above code so that it acts on a linked range of data
rather than a chart. I created the data range from an existing area of a
worksheet using the Camera tool. The objective is to save the data range as a
static picture so that I can use it in other applications. It would be more
helpful if the macro could refer to these ranges by a name rather than having
to manually activate the ranges. I am familiar with the process of renaming a
chart object instead of it being called "Chart1" etc I asssume that I would
follow the same convention in renaming these linked data ranges. Thanks in
advance for any help.

 

[bighead]

Can use the "Range.CopyPicture" function,and get date from Clipboar
with API

 

[Ben]

Your suggestion would be a step in the right direction but ideally I would
like to have the macro automate the process of writing the ranges to a folder
as GIfs or JPGs etc in the same way as in the example code that I submitted.

 

[Dave Peterson]

David McRitchie has some code from Harald Staff. You may find it interesting.
http://www.mvps.org/dmcritchie/excel/xl2gif.htm

Your suggestion would be a step in the right direction but ideally I would
like to have the macro automate the process of writing the ranges to a folder
as GIfs or JPGs etc in the same way as in the example code that I submitted.

 

[bighead]

A example ...............


+-------------------------------------------------------------------+
|Filename: saveRangBmp.zip |
|Download: http://www.excelforum.com/attachment.php?postid=3800 |
+-------------------------------------------------------------------+

 

[okaizawa]

Hi,

in excel 2000 and later versions, you can create a picture by copying
and pasting, and save it as a part of a web page. (no options for the
quality like compression ratio)
for example,

Sub SavePicture(Target As Object, Filename As String, _
Optional CopyBitmap As Boolean = False)
Dim TmpHtml As String, TmpFolder As String
Dim TmpFile As String, PictureFormat As String

TmpHtml = ThisWorkbook.Path & "\_tmp.htm"
TmpFolder = ThisWorkbook.Path & "\_tmp.files"

Select Case UCase(Right(Filename, 3))
Case "GIF": PictureFormat = "Picture (GIF)"
Case "JPG": PictureFormat = "Picture (JPEG)"
Case "PNG": PictureFormat = "Picture (PNG)"
Case Else: Exit Sub
End Select

If CopyBitmap Then
Target.CopyPicture xlScreen, xlBitmap
Else
Target.CopyPicture xlScreen, xlPicture
End If

Application.ScreenUpdating = False
With Workbooks.Add(xlWorksheet)
With .Worksheets(1)
.Paste
Selection.Cut
.PasteSpecial PictureFormat
End With
Application.DisplayAlerts = False
.SaveAs Filename:=TmpHtml, FileFormat:=xlHtml
.Close False
Application.DisplayAlerts = True
End With
Application.ScreenUpdating = True

TmpFile = Dir(TmpFolder & "\*." & Right(Filename, 3))
If TmpFile <> "" Then
FileCopy TmpFolder & "\" & TmpFile, Filename
End If

On Error Resume Next
Kill TmpFolder & "\*.*"
Kill TmpHtml
RmDir TmpFolder
On Error GoTo 0
End Sub

Sub Test_SavePicture()
If ThisWorkbook.Path = "" Then Exit Sub
SavePicture Range("A1:C10"), ThisWorkbook.Path & "\range.gif"
End Sub