F
Father Guido
Hi,
I've published my code here before and someone said it worked fine. I
think my problem may have been missing output filters in my XL2003
installation. I hadn't used the macro for ~18 months, at which time I
was using XL2002 successfully. I have a John Walkenbach add-in that
let's me export individually selected ranges as GIFs, and it was
failing also, and gave a missing filters possible error. I
re-installed Office 2003 doing a full install including filters. Now I
can export using John Walkenbach add-in (Pupv6), but not using my
macro from XL2002. So it would seem the GIF filter is now working, so
something in XL2003 must not like the code. The code always fails at
the following line.
ActiveChart.Export Filename:=LCase(SaveName), _
FilterName:="GIF"
The entire code follows the post for your amusement.
I did buy the access to Johns code, but so far I haven't been able to
open it up enough to determine how he saves one range as a GIF, so...
I'd like to email, or post the entire file (1Mb) including the macro
to someone running XL2003 to see if it will fail for them as well.
Hopefully, someone with enough smarts can test it and then help me to
fix the macro. Currently I have 20 ranges on my file to export as
GIFs, so doing this with a macro would sure be sweet compared to
selecting each range manually, and then using the add-in to convert it
to a GIF.
The code I have is quite good, it was written for me by Harold Staff a
couple of years back, and worked great under 2002.
Anyway, thanks for your time.
Norm
contact me at
norm at shaw dot ca
The entire macro code is as follows:
Option Explicit
'Harold Staff -- see
http://www.mvps.org/dmcritchie/excel/xl2gif.htm
'XL2GIF_module -- GIF_Snapshot
Dim container As Chart
Dim containerbok As Workbook
Dim Obnavn As String
Dim Sourcebok As Workbook
Private Sub ImageContainer_init()
Workbooks.Add (1)
ActiveSheet.Name = "GIFcontainer"
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Worksheets(1).Range("A1")
ActiveChart.Location Where:=xlLocationAsObject, _
Name:="GIFcontainer"
ActiveChart.ChartArea.ClearContents
Set containerbok = ActiveWorkbook
Set container = ActiveChart
End Sub
Sub MakeAndSizeChart(ih As Integer, iv As Integer)
Dim Hincrease As Single
Dim Vincrease As Single
Obnavn = Mid(ActiveChart.Name, Len(ActiveSheet.Name) + 1)
Hincrease = ih / ActiveChart.ChartArea.Height
ActiveSheet.Shapes(Obnavn).ScaleHeight Hincrease, _
msoFalse, msoScaleFromTopLeft
Vincrease = iv / ActiveChart.ChartArea.Width
ActiveSheet.Shapes(Obnavn).ScaleWidth Vincrease, _
msoFalse, msoScaleFromTopLeft
End Sub
Public Sub GIF_Snapshot()
Dim varReturn As Variant
Dim MyAddress As String
Dim SaveName As Variant
Dim MySuggest As String
Dim Hi As Integer
Dim Wi As Integer
Dim Suffiks As Long
Dim rng As Range
Dim ar As Range
Dim i As Integer
Set rng = Range("H1:Q22,A26:G39,A41:G52,A54:G67," & _
"A69:G84,A86:G102,A104:G118,A120:G136,A138:G152," & _
"A154:G167,A169:G184,A186:G200,A202:G216,A218:G236," & _
"A238:G256,A258:G273,A275:G287,A289:G308,A310:G324,A326:G340")
rng.Select
Set Sourcebok = ActiveWorkbook
ImageContainer_init
i = -1
For Each ar In rng.Areas
i = i + 1
container.ChartArea.ClearContents
SaveName = "C:\Documents and Settings\root\Desktop\Pool0506\t" &
i & ".gif"
Sourcebok.Activate
ar.Select
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
Hi = Selection.Height + 4 'adjustment for gridlines
Wi = Selection.Width + 6 'adjustment for gridlines
containerbok.Activate
ActiveSheet.ChartObjects(1).Activate
MakeAndSizeChart ih:=Hi, iv:=Wi
ActiveChart.Paste
ActiveChart.ChartArea.Border.LineStyle = 0
ActiveChart.Export Filename:=LCase(SaveName), _
FilterName:="GIF"
ActiveChart.Pictures(1).Delete
Sourcebok.Activate
Next
Avbryt:
On Error Resume Next
Application.StatusBar = False
containerbok.Close SaveChanges:=False
End Sub
I've published my code here before and someone said it worked fine. I
think my problem may have been missing output filters in my XL2003
installation. I hadn't used the macro for ~18 months, at which time I
was using XL2002 successfully. I have a John Walkenbach add-in that
let's me export individually selected ranges as GIFs, and it was
failing also, and gave a missing filters possible error. I
re-installed Office 2003 doing a full install including filters. Now I
can export using John Walkenbach add-in (Pupv6), but not using my
macro from XL2002. So it would seem the GIF filter is now working, so
something in XL2003 must not like the code. The code always fails at
the following line.
ActiveChart.Export Filename:=LCase(SaveName), _
FilterName:="GIF"
The entire code follows the post for your amusement.
I did buy the access to Johns code, but so far I haven't been able to
open it up enough to determine how he saves one range as a GIF, so...
I'd like to email, or post the entire file (1Mb) including the macro
to someone running XL2003 to see if it will fail for them as well.
Hopefully, someone with enough smarts can test it and then help me to
fix the macro. Currently I have 20 ranges on my file to export as
GIFs, so doing this with a macro would sure be sweet compared to
selecting each range manually, and then using the add-in to convert it
to a GIF.
The code I have is quite good, it was written for me by Harold Staff a
couple of years back, and worked great under 2002.
Anyway, thanks for your time.
Norm
contact me at
norm at shaw dot ca
The entire macro code is as follows:
Option Explicit
'Harold Staff -- see
http://www.mvps.org/dmcritchie/excel/xl2gif.htm
'XL2GIF_module -- GIF_Snapshot
Dim container As Chart
Dim containerbok As Workbook
Dim Obnavn As String
Dim Sourcebok As Workbook
Private Sub ImageContainer_init()
Workbooks.Add (1)
ActiveSheet.Name = "GIFcontainer"
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Worksheets(1).Range("A1")
ActiveChart.Location Where:=xlLocationAsObject, _
Name:="GIFcontainer"
ActiveChart.ChartArea.ClearContents
Set containerbok = ActiveWorkbook
Set container = ActiveChart
End Sub
Sub MakeAndSizeChart(ih As Integer, iv As Integer)
Dim Hincrease As Single
Dim Vincrease As Single
Obnavn = Mid(ActiveChart.Name, Len(ActiveSheet.Name) + 1)
Hincrease = ih / ActiveChart.ChartArea.Height
ActiveSheet.Shapes(Obnavn).ScaleHeight Hincrease, _
msoFalse, msoScaleFromTopLeft
Vincrease = iv / ActiveChart.ChartArea.Width
ActiveSheet.Shapes(Obnavn).ScaleWidth Vincrease, _
msoFalse, msoScaleFromTopLeft
End Sub
Public Sub GIF_Snapshot()
Dim varReturn As Variant
Dim MyAddress As String
Dim SaveName As Variant
Dim MySuggest As String
Dim Hi As Integer
Dim Wi As Integer
Dim Suffiks As Long
Dim rng As Range
Dim ar As Range
Dim i As Integer
Set rng = Range("H1:Q22,A26:G39,A41:G52,A54:G67," & _
"A69:G84,A86:G102,A104:G118,A120:G136,A138:G152," & _
"A154:G167,A169:G184,A186:G200,A202:G216,A218:G236," & _
"A238:G256,A258:G273,A275:G287,A289:G308,A310:G324,A326:G340")
rng.Select
Set Sourcebok = ActiveWorkbook
ImageContainer_init
i = -1
For Each ar In rng.Areas
i = i + 1
container.ChartArea.ClearContents
SaveName = "C:\Documents and Settings\root\Desktop\Pool0506\t" &
i & ".gif"
Sourcebok.Activate
ar.Select
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
Hi = Selection.Height + 4 'adjustment for gridlines
Wi = Selection.Width + 6 'adjustment for gridlines
containerbok.Activate
ActiveSheet.ChartObjects(1).Activate
MakeAndSizeChart ih:=Hi, iv:=Wi
ActiveChart.Paste
ActiveChart.ChartArea.Border.LineStyle = 0
ActiveChart.Export Filename:=LCase(SaveName), _
FilterName:="GIF"
ActiveChart.Pictures(1).Delete
Sourcebok.Activate
Next
Avbryt:
On Error Resume Next
Application.StatusBar = False
containerbok.Close SaveChanges:=False
End Sub