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
~