VBA Save chart as png not saving correctly... Step through and it's working?!?

szita2000

Board Regular
Joined
Apr 25, 2012
Messages
76
Office Version
  1. 365
Platform
  1. Windows
Hi guys.

I am using this code from Jon Peltier:


Code:
Sub ExportRangeToPNG()
  '--exports selected range to png file
  '  jpg is not appropriate format for this output
  '  default filename is address of selected range
  '  based on code example posted at:
  '     http://www.emoticode.net/visual-basic/vba-export-excel-range-as-image-and-save-as-file.html
  '  modified at
  '     http://www.mrexcel.com/forum/excel-questions/751500-export-range-cells-jpg.html#post3691601
  '  further refined by Jon Peltier, Peltier Technical Services, Inc.


  Dim vFilePath As String
  Dim rSelection As Range
  Dim sDefaultName As String
  Dim t As Variant


  If TypeName(Selection) <> "Range" Then
    MsgBox "Selection is not a range of cells."
    Exit Sub
  End If


  Set rSelection = Sheet7.Range("A1:K39")
  
  


    sDefaultName = "test.png"
  vFilePath = "G:\ASTER\11 Production\DDS\Aster DDS output files\test.png"




  '-- copy selected range as picture (not as bitmap)
  rSelection.CopyPicture Appearance:=xlScreen, Format:=xlPicture


  '--Create an empty chart, slightly larger than exact size of range copied
  With ActiveSheet.ChartObjects.Add( _
      Left:=rSelection.Left, Top:=rSelection.Top, _
      Width:=rSelection.Width + 2, Height:=rSelection.Height + 2)


    With .Chart
      ' clean up chart
      .ChartArea.Format.Line.Visible = msoFalse
      
      ' paste and position picture
[B][COLOR=#b22222]      .Paste[/COLOR][/B]
[B][COLOR=#b22222]      t = Now + TimeValue("00:00:05")[/COLOR][/B]

[B][COLOR=#b22222]      Do While t > Now[/COLOR][/B]
[B][COLOR=#b22222]        DoEvents[/COLOR][/B]
[B][COLOR=#b22222]      Loop[/COLOR][/B]
        
      
[B][COLOR=#008000]'      With .Pictures(1)[/COLOR][/B]
[B][COLOR=#008000]'        .Left = .Left + 2[/COLOR][/B]
[B][COLOR=#008000]'        .Top = .Top + 2[/COLOR][/B]
[B][COLOR=#008000]'      End With[/COLOR][/B]

      ' export
      .Export CStr(vFilePath)
    End With
    
    ' remove no-longer-needed chart
    .Delete
  End With
End Sub

If I put a stop at the .Paste and step through it, it saves the picture correctly.
If I run it normally, the png is empty. -ergo the paste does not happening.

As you can see I put a DoEvents timer in, and I took that up to 5 sec. But it still does not work.

Also, another question with the green bit,
This supposed to nudge the pasted picture in the slightly bigger chart, however this crops out with Object required error.

Any help much appreciated.
Thanks

Tom
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,495
Try activating the chart before pasting and exporting...

Code:
With ActiveSheet.ChartObjects.Add( _
      Left:=rSelection.Left, Top:=rSelection.Top, _
      Width:=rSelection.Width + 2, Height:=rSelection.Height + 2)
    
    With .Chart
        [COLOR=#ff0000].ChartArea.Select[/COLOR]
        'etc
        '
        '
        '
        '
    End With
  
End With
 

szita2000

Board Regular
Joined
Apr 25, 2012
Messages
76
Office Version
  1. 365
Platform
  1. Windows
Hi Domenic.

It worked!

I had to put the .Chart area.Select before the paste.
I even managed to remove the DoEvents.

Thanks
 

Watch MrExcel Video

Forum statistics

Threads
1,129,498
Messages
5,636,677
Members
416,935
Latest member
Atulcp

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top