Print Charts

[jl2509]

Hi All,

The problem I have is: There are many charts on a worksheet which are only visible when data is present
Each of the charts is setup in layout i.e. 1 chart per page, page breaks, print area etc.

However, when I print the charts, I get all the active charts and many blank pages?

Can anyone help with some VBA to select all charts on a worksheet and print them on a pdf.
The PDF should be 1 chart per page but a continuous PDF.

or

Is there a way to stop the blank ranges / pages being printed?

Thanks

 

[ParamRay]

Here's a macro that will do it. Could assign the macro to a button on the worksheet if you want.

Public Sub ExportChartsAsPdf()
  On Error GoTo ErrHandler
  Dim vntFilename As Variant
  Dim wksSource As Worksheet
  Dim wbkTemp As Workbook
  Dim chtObj As ChartObject
  
' Check active sheet is a worksheet
  If Not TypeOf ActiveSheet Is Worksheet Then
    MsgBox "Activate a worksheet first.", vbExclamation
    GoTo ExitProc
  End If
  
' Check active sheet contains charts
  Set wksSource = ActiveSheet
  If wksSource.ChartObjects.Count = 0 Then
    MsgBox "Active worksheet does not contain any chart objects.", vbExclamation
    GoTo ExitProc
  End If
  
' Get save filename from user
GetFilename:
  vntFilename = Application.GetSaveAsFilename(wksSource.Parent.Path & "\Charts.pdf", _
                                              "PDF (*.pdf), *.pdf", , "Export As PDF")
' Exit if user cancelled save dialog
  If vntFilename = False Then GoTo ExitProc
  
' If filename already exists, check before overwriting
  If Dir(vntFilename) <> "" Then
    If MsgBox("Overwrite existing file?", vbQuestion + vbYesNo) = vbYes Then
      Kill vntFilename
    Else
      GoTo GetFilename
    End If
  End If
  
' Copy charts from active sheet to temp workbook
  Set wbkTemp = Workbooks.Add
  For Each chtObj In wksSource.ChartObjects
    chtObj.Copy
    With wbkTemp.Charts.Add
      .Activate
      .Paste
    End With
  Next chtObj
  
' Export temp workbook as PDF
  wbkTemp.ExportAsFixedFormat Type:=xlTypePDF, _
                              Filename:=vntFilename, _
                              OpenAfterPublish:=True
ExitProc:
  On Error Resume Next
  wbkTemp.Close False
  Set wksSource = Nothing
  Set wbkTemp = Nothing
  Set chtObj = Nothing
  Exit Sub
  
ErrHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitProc
End Sub

 

[jl2509]

Hi
Appreciate the response

I will check out the proposal and let you know the results

I guess I should have mentioned that the Charts worksheet is hidden and the macro is attached to a cmdbutton on another sheet.

Will this VBA work attached to a button where the charts are on another sheet?

cmdButton is located on sheet = worksheet "ChartData"
charts are located on = worksheet "Charts All"

Thank you

 

[ParamRay]

Yes, you should have mentioned both of those things beforehand. Perhaps someone else will help you modify the given macro to accommodate these new requirements...

 

[jl2509]

Apologies, in my haste to get a post submitted, I focused on the fine detail, and omitted an important part.

 

[ParamRay]

OK, have made the adjustment below. Doesn't matter that the sheet is hidden.

Public Sub ExportChartsAsPdf()
  On Error GoTo ErrHandler
  Dim vntFilename As Variant
  Dim wksSource As Worksheet
  Dim wbkTemp As Workbook
  Dim chtObj As ChartObject
  
' Set sheet containing the charts
  Set wksSource = ThisWorkbook.Sheets("Charts All")
  If wksSource.ChartObjects.Count = 0 Then
    MsgBox "Worksheet does not contain any chart objects.", vbExclamation
    GoTo ExitProc
  End If
  
' Get save filename from user
GetFilename:
  vntFilename = Application.GetSaveAsFilename(wksSource.Parent.Path & "\Charts.pdf", _
                                              "PDF (*.pdf), *.pdf", , "Export As PDF")
' Exit if user cancelled save dialog
  If vntFilename = False Then GoTo ExitProc
  
' If filename already exists, check before overwriting
  If Dir(vntFilename) <> "" Then
    If MsgBox("Overwrite existing file?", vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
      Kill vntFilename
    Else
      GoTo GetFilename
    End If
  End If
  
' Copy charts from active sheet to temp workbook
  Set wbkTemp = Workbooks.Add
  For Each chtObj In wksSource.ChartObjects
    chtObj.Copy
    With wbkTemp.Charts.Add
      .Activate
      .Paste
    End With
  Next chtObj
  
' Export temp workbook as PDF
  wbkTemp.ExportAsFixedFormat Type:=xlTypePDF, _
                              Filename:=vntFilename, _
                              OpenAfterPublish:=True
ExitProc:
  On Error Resume Next
  wbkTemp.Close False
  Set wksSource = Nothing
  Set wbkTemp = Nothing
  Set chtObj = Nothing
  Exit Sub
  
ErrHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitProc
End Sub

 

[jl2509]

Hi and thank you for the response

I put the macro in my workbook and I get the error "Application-defined or object-defined error"
The charts appear to be saving, or are asked for a location and filename, but do not save when you click ok in the error box...

Any thoughts?