VBA script works when stepped through, but not when run in realtime

[Rogue82]

HI there, Hoping for some help.

I have run this code on an older machine (and older version of Excel) without problem for over a year. I have just switched to a new machine and now it doesn't funtion correctly. The code should take a snapshot of the Excel sheet, enlarge it and export it as a .png image, saving it to the desktop. It is saving to the desktop, but only as a blank image. The issue apears to occur around the 'chartobj.Chart.Paste' or 'chartobj.Chart.Export sFilePath, "png"'

Any suggestions gratefully recieved.



Sub ExportImage()
'PURPOSE: Save a shot of the Calender to the desktop
Dim sFilePath As String
Dim sView As String
'Captures current window view
sView = ActiveWindow.View
'Sets the current view to normal so there are no "Page X" overlays on the image
ActiveWindow.View = xlNormalView
'Temporarily disable screen updating
Application.ScreenUpdating = False
Set Sheet = ActiveSheet
'Set the file path to export the image to the user's desktop
sFilePath = CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & ActiveSheet.Range("H2").Text & ".png"
'Export print area as correctly scaled PNG image, courtasy of Winand
zoom_coef = 100 / Sheet.Parent.Windows(1).Zoom
Set area = Sheet.Range(Sheet.PageSetup.PrintArea)
On Error GoTo HERE
HERE:
area.CopyPicture xlPrinter
Set chartobj = Sheet.ChartObjects.Add(0, 0, area.Width * zoom_coef, area.Height * zoom_coef)
chartobj.Chart.Paste
chartobj.Chart.Export sFilePath, "png"
chartobj.Delete
'Returns to the previous view
ActiveWindow.View = sView
'Re-enables screen updating
Application.ScreenUpdating = True
End Sub


Thanks

[SamT]

Just my personal preference, but I would change the variables Sheet and area to Sht and Ar.

Then explicitly declare all the variables in the sub

After

chartobj.Chart.Export sFilePath, "png"
Add

DoEvents

[arnelgp]

not tested yet.


Sub ExportImage()
'PURPOSE: Save a shot of the Calender to the desktop
Dim sFilePath As String
Dim sView As String
'Captures current window view
sView = ActiveWindow.View
'Sets the current view to normal so there are no "Page X" overlays on the image
ActiveWindow.View = xlNormalView
'Temporarily disable screen updating
Application.ScreenUpdating = False
Set Sheet = ActiveSheet
'Set the file path to export the image to the user's desktop
sFilePath = CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & ActiveSheet.Range("H2").Text & ".png"
'Export print area as correctly scaled PNG image, courtasy of Winand
zoom_coef = 100 / Sheet.Parent.Windows(1).Zoom
Set area = Sheet.Range(Sheet.PageSetup.PrintArea)
On Error GoTo HERE
HERE:
area.CopyPicture xlPrinter
'arnelgp
'Set chartobj = Sheet.ChartObjects.Add(0, 0, area.Width * zoom_coef, area.Height * zoom_coef)
With Sheet
.Shapes.AddChart
.Activate
.Shapes.Item(1).Width = area.Width * zoom_coef
.Shapes.Item(1).Height= area.Height * zoom_coef
.Shapes.Item(1).Select
Set objChart = ActiveChart
End With
chartobj.Chart.Paste
chartobj.Chart.Export sFilePath, "png"
'chartobj.Delete
Dim shape_count As Integer
shape_count = Sheet.Shapes.Count
For i = 1 To shape_count
Sheet.Shapes.Item(1).Delete
Next i
'end of arnelgp code
'Returns to the previous view
ActiveWindow.View = sView
'Re-enables screen updating
Application.ScreenUpdating = True
End Sub

[Rogue82]

Thanks Sam,
I've declared the variables and added the DoEvents, but still end up with the same result, works fine stepping through, but running just saves a blank file.


Sub ExportImage2()
'PURPOSE: Save a shot of the Calender to the desktop

'Captures current window view
Dim sView As String
sView = ActiveWindow.View

'Sets the current view to normal so there are no "Page X" overlays on the image
ActiveWindow.View = xlNormalView

'Temporarily disable screen updating
Application.ScreenUpdating = False

Dim Sht As Worksheet
Set Sht = ActiveSheet

'Set the file path to export the image to the user's desktop
Dim sFilePath As String
sFilePath = CreateObject("WScript.Shell").specialfolders("Desktop") & "" & Sht.Range("H2").Text & ".png"

'Export print area as correctly scaled PNG image, courtasy of Winand
zoom_coef = 100 / Sht.Parent.Windows(1).Zoom
Dim Ar As Range
Set Ar = Sht.Range(Sht.PageSetup.PrintArea)
On Error GoTo HERE
HERE:
Ar.CopyPicture xlPrinter

Dim Chartobj As Object
Set Chartobj = Sht.ChartObjects.Add(0, 0, Ar.Width * zoom_coef, Ar.Height * zoom_coef)
Chartobj.Chart.Paste
Chartobj.Chart.Export sFilePath, "png"
DoEvents
Chartobj.Delete

'Returns to the previous view
ActiveWindow.View = sView

'Re-enables screen updating
Application.ScreenUpdating = True

End Sub

[Rogue82]

Thanks arnelgp,

I tried that code, once it's been through the With Sheet statement, it appears to loop back up to area.CopyPicture xlPrinter. Then gives a Run-time error '424' Object Required, on the line Chartobj.Chart.Paste.

It also appears t delete all of the other shapes on the sheet which I need to keep in place.

[arnelgp]

here is the correction:


Sub ExportImage()
'PURPOSE: Save a shot of the Calender to the desktop
Dim sFilePath As String
Dim sView As String
Dim n As Integer
Dim objChart As Chart
'Captures current window view
sView = ActiveWindow.View
'Sets the current view to normal so there are no "Page X" overlays on the image
ActiveWindow.View = xlNormalView
'Temporarily disable screen updating
Application.ScreenUpdating = False
Set Sheet = ActiveSheet
'Set the file path to export the image to the user's desktop
sFilePath = CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & ActiveSheet.Range("H2").Text & ".png"
'Export print area as correctly scaled PNG image, courtasy of Winand
zoom_coef = 100 / Sheet.Parent.Windows(1).Zoom
Set area = Sheet.Range(Sheet.PageSetup.PrintArea)
On Error GoTo HERE
HERE:
'area.CopyPicture xlPrinter
area.CopyPicture xlScreen, xlPicture
'arnelgp
'Set chartobj = Sheet.ChartObjects.Add(0, 0, area.Width * zoom_coef, area.Height * zoom_coef)
With Sheet
.Shapes.AddChart
.Activate
n = .Shapes.Count
.Shapes.Item(n).Select
Set objChart = ActiveChart
With .Shapes.Item(n)
.Line.Visible = msoFalse
.Width = area.Width * zoom_coef
.Height = area.Height * zoom_coef
End With
End With
With objChart
.SeriesCollection(1).Delete
.Paste
.Export sFilePath, "png"
End With
'chartobj.Delete
Sheet.Shapes.Item(n).Delete
'end of arnelgp code
'Returns to the previous view
ActiveWindow.View = sView
'Re-enables screen updating
Application.ScreenUpdating = True
End Sub

[snb]

Avoid redundant variables (especially Object variables); simultaneously avoiding declaration of variables.


Sub M_snb()
ActiveWindow.View = 1

With ActiveSheet.Range(ActiveSheet.PageSetup.PrintArea)
.CopyPicture
With ActiveSheet.ChartObjects.Add(0, 0, .Width, .Height).Chart
.Paste
.Parent.Activate
.Export CreateObject("wscript.shell").specialfolders(4) & "\" & [H2] & ".png"
.Parent.Delete
End With
End With
End Sub

[Rogue82]

Thank you arnelgp, I'm now getting a Run-time error '1004' Parameter not valid at With objChart .SeriesCollection(1).Delete

[Rogue82]

Hi snb, Thanks for the reply. Again, this works when stepped through, but not when just running the sub.

[snb]

I hope you didn't change anything in the code.

Try:

Sub M_snb()
ActiveWindow.View = 1
Application.ScreenUpdating = True
With ActiveSheet.Range(ActiveSheet.PageSetup.PrintArea)
.CopyPicture
With .Parent.ChartObjects.Add(0, 0, .Width, .Height).Chart
.Parent.Activate
.Paste
.Export CreateObject("wscript.shell").specialfolders(4) & "\" & [H2] & ".png"
.Parent.Delete
End With
End With
End Sub

[Rogue82]

Thanks snb.
No I didn't change anything and this new one works when run, thank you.

The only thing its no longer doing is pasting it at a larger size as my original code was, any idea why not?

[snb]

You can enlarge a picture ad libitum afterwards.

[arnelgp]

Thank you arnelgp, I'm now getting a Run-time error '1004' Parameter not valid at With objChart .SeriesCollection(1).Delete
you can Comment out that line.

[Rogue82]

Sorry for the delayed reply, been a busy few days


You can enlarge a picture ad libitum afterwards.
Hi snb,
Below is the final tweaks I made to your code. It now enlarges the image prior to saving. Thanks for your help on this one.

Sub M_snb2()
ActiveWindow.View = 1
Application.ScreenUpdating = True
zoom_coef = 100 / ActiveSheet.Parent.Windows(1).Zoom

With ActiveSheet.Range(ActiveSheet.PageSetup.PrintArea)
.CopyPicture xlPrinter

With .Parent.ChartObjects.Add(0, 0, .Width * zoom_coef, .Height * zoom_coef).Chart
.Parent.Activate
.Paste
.Export CreateObject("wscript.shell").specialfolders(4) & "\" & [H2] & ".png"
.Parent.Delete
End With
End With
End Sub



you can Comment out that line.
Hi arnelgp,

this code exported the chart at the desied size, but not the image, the image remained 1/4 size in the corner. I'll go with snb's solution but thank you for your help.