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 Whe=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:G15 2," & _
"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

Hi,

Have you tried using John's addin to save gif files to the same desktop
location as in your code? Is it possible that the path is incorrect and
that is why Harald's code in now failing?

What error do you get?

And you may want to re think email John's code. I'm not sure but even if
you brought access to the code you may not be able to simply email to
others. Perhaps check the licence agreement first.

Cheers
Andy


Father Guido wrote:
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 Whe=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:G15 2," & _
"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

--

Andy Pope, Microsoft MVP - Excel
http://www.andypope.info

On Sat, 19 Nov 2005 15:23:44 +0000, Andy Pope
wrote:

~Hi,
~
~Have you tried using John's addin to save gif files to the same
desktop
~location as in your code? Is it possible that the path is incorrect
and
~that is why Harald's code in now failing?

+-----------------------------------------------------------------+
|No, I can save using John's add-in to the same folder no problem.|
+-----------------------------------------------------------------+

~What error do you get?

+-----------------------------------------------------------------+
|No error per se, the Macro just fails at the following line |
| |
| ActiveChart.Export Filename:=LCase(SaveName), _ |
| FilterName:="GIF" |
+-----------------------------------------------------------------+


~And you may want to re think email John's code. I'm not sure but even
~if you brought access to the code you may not be able to simply email
~to others. Perhaps check the licence agreement first.

+-----------------------------------------------------------------+
| No, I don't want to mail Johns code, I want to mail my code, to |
| see if anyone else runs into the same problem on their XL2003. |
+-----------------------------------------------------------------+

~Cheers
~Andy

Thanks for your help!

Norm

__________________________________________________ ________________
~Father Guido wrote:
~ 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 Whe=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:G15 2," & _
~ "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

Hi,

I have already tried the code, by Harald, you included and it worked for me.
If you want to email me direct your workbook and code I will take a look.

Cheers
Andy

Father Guido wrote:
On Sat, 19 Nov 2005 15:23:44 +0000, Andy Pope
wrote:

~Hi,
~
~Have you tried using John's addin to save gif files to the same
desktop
~location as in your code? Is it possible that the path is incorrect
and
~that is why Harald's code in now failing?

+-----------------------------------------------------------------+
|No, I can save using John's add-in to the same folder no problem.|
+-----------------------------------------------------------------+

~What error do you get?

+-----------------------------------------------------------------+
|No error per se, the Macro just fails at the following line |
| |
| ActiveChart.Export Filename:=LCase(SaveName), _ |
| FilterName:="GIF" |
+-----------------------------------------------------------------+


~And you may want to re think email John's code. I'm not sure but even
~if you brought access to the code you may not be able to simply email
~to others. Perhaps check the licence agreement first.

+-----------------------------------------------------------------+
| No, I don't want to mail Johns code, I want to mail my code, to |
| see if anyone else runs into the same problem on their XL2003. |
+-----------------------------------------------------------------+

~Cheers
~Andy

Thanks for your help!

Norm

__________________________________________________ ________________
~Father Guido wrote:
~ 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 Whe=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:G15 2," & _
~ "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


--

Andy Pope, Microsoft MVP - Excel
http://www.andypope.info

On Mon, 21 Nov 2005 08:53:17 +0000, Andy Pope
wrote:

~Hi,
~
~I have already tried the code, by Harald, you included and it worked
for me.
~If you want to email me direct your workbook and code I will take a
look.
~
~Cheers
~Andy

Hi Andy,

I'll be glad to take you up on your offer. Thanks.

I just can't figure out why it won't work for me using XL2003
when it worked fine in XL2002 the last time I ran it in April 2004.

Norm



~
~Father Guido wrote:
~ On Sat, 19 Nov 2005 15:23:44 +0000, Andy Pope
~ wrote:
~
~ ~Hi,
~ ~
~ ~Have you tried using John's addin to save gif files to the same
~ desktop
~ ~location as in your code? Is it possible that the path is
incorrect
~ and
~ ~that is why Harald's code in now failing?
~
~ +-----------------------------------------------------------------+
~ |No, I can save using John's add-in to the same folder no problem.|
~ +-----------------------------------------------------------------+
~
~ ~What error do you get?
~
~ +-----------------------------------------------------------------+
~ |No error per se, the Macro just fails at the following line |
~ | |
~ | ActiveChart.Export Filename:=LCase(SaveName), _ |
~ | FilterName:="GIF" |
~ +-----------------------------------------------------------------+
~
~
~ ~And you may want to re think email John's code. I'm not sure but
even
~ ~if you brought access to the code you may not be able to simply
email
~ ~to others. Perhaps check the licence agreement first.
~
~ +-----------------------------------------------------------------+
~ | No, I don't want to mail Johns code, I want to mail my code, to |
~ | see if anyone else runs into the same problem on their XL2003. |
~ +-----------------------------------------------------------------+
~
~ ~Cheers
~ ~Andy
~
~ Thanks for your help!
~
~ Norm
~
~ __________________________________________________ ________________
~ ~Father Guido wrote:
~ ~ 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 Whe=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:G15 2," & _
~ ~ "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
~