F
Father Guido
Hi,
I'm trying to revise an old macro that Harold Staff wrote for me about
two years ago. It was running on XL97 at the time w/Windows 95. I now
have XL2000 and Windows XP. When I run the macro it chokes on the first
range selection at the following line, just before the next statement
near the very bottom of the script.
ActiveChart.Export Filename:=LCase(SaveName), _
FilterName:="GIF"
ActiveChart.Pictures(1).Delete
Sourcebok.Activate
I get...
Run-time error '1004'
Method 'Export' of object '_Chart' failed
Is the ActiveChart.Export not supported in XL2000?
How can I correct it
Thanks a million!!!
Norm
PS For anyone else who's interested. I run a series of macros to collect
sports information for a hockey pool, sort the data, order it etc. ready
to publish to the web. To simplify matters, I publish the results as a
series of GIF images, which is what the series of ranges represent.
------------------------------------------------------
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:Q19,A23:G39,A41:G56,A58:G76," & _
"A78:G97,A99:G116,A118:G131,A133:G149,A151:G170," & _
"A172:G191,A193:G211,A213:G229,A231:G250,A252:G268," & _
"A270:G287,A289:G306,A308:G325")
rng.Select
Set Sourcebok = ActiveWorkbook
ImageContainer_init
i = -1
For Each ar In rng.Areas
i = i + 1
container.ChartArea.ClearContents
SaveName = "c:\windows\desktop\pool0102\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.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
Father Guido
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
I plan on living forever... so far, so good
I'm trying to revise an old macro that Harold Staff wrote for me about
two years ago. It was running on XL97 at the time w/Windows 95. I now
have XL2000 and Windows XP. When I run the macro it chokes on the first
range selection at the following line, just before the next statement
near the very bottom of the script.
ActiveChart.Export Filename:=LCase(SaveName), _
FilterName:="GIF"
ActiveChart.Pictures(1).Delete
Sourcebok.Activate
I get...
Run-time error '1004'
Method 'Export' of object '_Chart' failed
Is the ActiveChart.Export not supported in XL2000?
How can I correct it
Thanks a million!!!
Norm
PS For anyone else who's interested. I run a series of macros to collect
sports information for a hockey pool, sort the data, order it etc. ready
to publish to the web. To simplify matters, I publish the results as a
series of GIF images, which is what the series of ranges represent.
------------------------------------------------------
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:Q19,A23:G39,A41:G56,A58:G76," & _
"A78:G97,A99:G116,A118:G131,A133:G149,A151:G170," & _
"A172:G191,A193:G211,A213:G229,A231:G250,A252:G268," & _
"A270:G287,A289:G306,A308:G325")
rng.Select
Set Sourcebok = ActiveWorkbook
ImageContainer_init
i = -1
For Each ar In rng.Areas
i = i + 1
container.ChartArea.ClearContents
SaveName = "c:\windows\desktop\pool0102\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.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
Father Guido
¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
I plan on living forever... so far, so good