I have written a Macro script which takes a select group of sheets in an excel file and exports them all as a single PDF document. However, there are cases where the recipient of these documents needs multiple copies of certain pages within this combined pdf. I am wondering if I would be able to set it so that certain sheets have duplicate pages within the final exported PDF.
For example, suppose sheet1 is one of the sheets that goes into the final PDF. I would want to find a way to have it so that the page from sheet1 is duplicated multiple times.
Here is the raw code for the macro along w/ a helper function it uses:
Sub ExportToPDF()
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim mds As Worksheet
Set mds = wb.Sheets("Master Data Sheet")
Dim DefaultSheets, SelectedSheets As Variant
DefaultSheets = Array("Proforma Invoice", "SLI", "VGM Form", "Commercial Invoice", "Cert of Origin", "Packing List")
Dim Country, Company, CurrDate, OrderNo, FilePath As String
Country = mds.Range("E49").Value
Company = mds.Range("D36").Value
CurrDate = mds.Range("E46").Value
OrderNo = mds.Range("E39").Value
For Each Sheet In Array("Master Data Sheet", "Multi Order Queries", "Packing List Query")
wb.Worksheets(Sheet).Visible = xlSheetHidden
Next
FilePath = GetFolder()
wb.ExportAsFixedFormat _
Type:=xlTypePDF, _
IncludeDocProperties:=True, _
Filename:=FilePath + "\" + Company + "_" + OrderNo + "_" + CurrDate + ".pdf", _
OpenAfterPublish:=True
For Each Sheet In Array("Master Data Sheet", "Multi Order Queries", "Packing List Query")
wb.Worksheets(Sheet).Visible = xlSheetVisible
Next
mds.Activate
Helper:
Function GetFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
This works for me - create required number of copies of the sheet, export, then remove the copies.
Note you don't need to hide the other sheets if you only export the selected worksheets.
Sub ExportToPDF()
Const WSTOCOPY As String = "SLI" 'for example: the sheet to be copied
Dim wb As Workbook, mds As Worksheet, wsName, first As Boolean
Dim DefaultSheets, SelectedSheets As Variant, NumCopies As Long, i As Long
Dim Country As String, Company As String, CurrDate As String
Dim OrderNo As String, FilePath As String, wsCopy As Worksheet
Set wb = ActiveWorkbook
Set mds = wb.Sheets("Master Data Sheet")
DefaultSheets = Array("Proforma Invoice", "SLI", "VGM Form", _
"Commercial Invoice", "Cert of Origin", _
"Packing List")
Country = mds.Range("E49").Value
Company = mds.Range("D36").Value
CurrDate = mds.Range("E46").Value
OrderNo = mds.Range("E39").Value
NumCopies = mds.Range("B5").Value 'for example
Set wsCopy = wb.Worksheets(WSTOCOPY)
CreateCopies wsCopy, NumCopies 'create any required copies
first = True
For Each wsName In DefaultSheets
ThisWorkbook.Worksheets(wsName).Select first 'if true then replaces current selection
first = False ' otherwise adds the sheet to the current selection
If wsName = wsCopy.Name Then
For i = 1 To NumCopies - 1 'select all the copies of the sheet
wb.Worksheets(wsCopy.Index + i).Select first
Next i
End If
Next wsName
FilePath = GetFolder()
'export only selected sheets
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, IncludeDocProperties:=True, _
Filename:=FilePath + "\" + Company + "_" + OrderNo + "_" + CurrDate + ".pdf", _
OpenAfterPublish:=True
RemoveCopies wb 'remove any copies
mds.Select
End Sub
'Create copies of worksheet `wsRep`
Sub CreateCopies(wsRep As Worksheet, totalCopies As Long)
Dim i As Long, ws As Worksheet
Set ws = wsRep
For i = 1 To totalCopies - 1
wsRep.Copy after:=ws
Set ws = wsRep.Parent.ActiveSheet '#fixed for hidden sheets
ws.Name = wsRep.Name & "_COPY" & (i + 1)
Next i
End Sub
'remove all worksheets in `wb` where name contains "_COPY"
Sub RemoveCopies(wb As Workbook)
Dim i As Long
Application.DisplayAlerts = False
For i = wb.Worksheets.Count To 1 Step -1
With wb.Worksheets(i)
If UCase(.Name) Like "*_COPY*" Then .Delete
End With
Next i
Application.DisplayAlerts = True
End Sub