PDA

View Full Version : Export bespoke PDF macro



Dome92
08-16-2023, 07:03 AM
Hi all, I am asking again for help to solve a issue I'm encountering.

I'm trying to write a macro that exports into a PDF a specific range (that bit works) as well as all charts from a defined tab of the spreadsheet. I want to limit to max 4 charts for each page and they have to fit the PDF page.
So ideally the PDF would start with the table in the range I define followed by a couple of charts, then in the following page max 4 charts and so on. As mentioned the first bit works but I'm stuck on the charts.


Sub ExportChartsToPDF() Dim wsCharts As Worksheet
Dim wsAnalysis As Worksheet
Dim chtObj As ChartObject
Dim pdfFilePath As String
Dim exportRange As Range
Dim rowCounter As Long, colCounter As Long
Dim totalChartsPerPDFPage As Long

' Set the worksheets
Set wsCharts = ThisWorkbook.Sheets("Charts")
Set wsAnalysis = ThisWorkbook.Sheets("Analysis")

' Set the PDF file path
pdfFilePath = ThisWorkbook.Path & "\ExportedPDF.pdf"

' Ask user for the range to export on Analysis sheet
On Error Resume Next
Set exportRange = Application.InputBox("Select the range to export on Analysis sheet:", Type:=8)
On Error GoTo 0

If exportRange Is Nothing Then
MsgBox "Export canceled.", vbExclamation
Exit Sub
End If

' Determine the number of charts per PDF page
totalChartsPerPDFPage = 4

' Set initial position
rowCounter = 1
colCounter = 1

' Export each chart to PDF
For Each chtObj In wsCharts.ChartObjects
' Check if we need to start a new PDF page
If (rowCounter Mod totalChartsPerPDFPage) = 0 Then
If rowCounter > 0 Then
' Export the PDF page when the charts per page limit is reached
wsCharts.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFilePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
wsCharts.Cells.ClearContents ' Clear the chart area for the next page
End If
rowCounter = 1 ' Reset row counter
colCounter = 1 ' Reset col counter
End If

' Move the chart to the current position
chtObj.Top = wsCharts.Cells(rowCounter, colCounter).Top
chtObj.Left = wsCharts.Cells(rowCounter, colCounter).Left

' Increment counters
If colCounter < totalChartsPerPDFPage Then
colCounter = colCounter + 1
Else
colCounter = 1
rowCounter = rowCounter + 1
End If
Next chtObj

' Export the remaining charts on the last PDF page
If rowCounter > 1 Then
wsCharts.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFilePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
End If

' Set the print area for Analysis sheet
wsAnalysis.PageSetup.PrintArea = exportRange.Address

' Export the Analysis sheet to PDF
wsAnalysis.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFilePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False

' Reset the print area
wsAnalysis.PageSetup.PrintArea = ""

MsgBox "PDF created successfully!", vbInformation
End Sub




Your help would be hugely appreciated :)

Thanks