I have a list of sheet names in the workbook that I want to print to a pdf.
This list starts in cell e13 on the "Print Packages" sheet of the workbook and proceeds vertically, (next sheet name in e14, and e15, and so on).
My code attaches the Print Packages sheet to the pdf it prints out, which I do not want.
Is there is a solution or more efficient way?
Sub Print_Investor_Summary()
Save_PDF
End Sub
Function Save_PDF() As Boolean
Dim Thissheet As String, ThisFile As String, PathName As String
Dim SvAs As String
Dim MyName As String ' Added variable declaration for MyName
Dim ws As Worksheet ' Added variable declaration for the worksheet
Set ws = ThisWorkbook.Worksheets("Print Packages") ' Change "Print Packages" to the actual sheet name
MyName = Range("C3").Value & " Summary"
SvAs = ThisWorkbook.Path & "\" & MyName & ".pdf" ' Updated the file save name with the full path
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
If lastRow < 13 Then lastRow = 13 ' Set the minimum lastRow value to 13
Dim mySheets1() As Variant
ReDim mySheets1(1 To lastRow - 12) ' Adjust the array size based on the number of values
Dim i As Long
For i = 13 To lastRow ' Start from row 13 in Column E
mySheets1(i - 12) = ws.Cells(i, "E").Value ' Add the value to the array
Next i
Application.ScreenUpdating = False
Dim sheetName As Variant
Dim sheetNames As String
' Concatenate the contents of mySheets1 into a string
For Each sheetName In mySheets1
sheetNames = sheetNames & sheetName & vbCrLf
Next sheetName
' Display the contents of mySheets1 in a message box
MsgBox "mySheets1 contains:" & vbCrLf & sheetNames
' Select and activate the necessary worksheets
For Each sheet In mySheets1
ThisWorkbook.Worksheets(sheet).Select False
Next sheet
' Set Print Quality
On Error Resume Next
ws.PageSetup.PrintQuality = 600
Err.Clear
On Error GoTo 0
On Error GoTo SaveError
Dim currentSheet As Worksheet
For Each sheet In mySheets1
Set currentSheet = ThisWorkbook.Worksheets(sheet)
If currentSheet.Name <> ActiveSheet.Name Then
currentSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=SvAs, Quality:=xlQualityMaximum, IncludeDocProperties:=False, IgnorePrintAreas:=False
End If
Next sheet
On Error GoTo 0
Save_PDF = True ' Return True to indicate successful execution
' Open the PDF file on the user's computer
On Error Resume Next
Shell "explorer.exe " & Chr(34) & SvAs & Chr(34), vbNormalFocus
On Error GoTo 0
Sheets("Print Packages").Select
EndMacro:
Application.DisplayAlerts = True ' Added to re-enable display alerts
Application.ScreenUpdating = True ' Added to re-enable screen updating
Exit Function
SaveError:
MsgBox "Unable to save as PDF. Please check your file path and try again."
Save_PDF = False ' Return False to indicate error
Resume EndMacro ' Go to EndMacro label to enable re-enabling display alerts and screen updating
End Function
I tried forcibly excluding it from the variant that contains the names of the sheets.
I have a portion of the code to display the names of the sheets in mysheets1 that shows that the active sheet is not part of the array.
ThisWorkbook.Worksheets(sheet).Select False adds the worksheet sheet to the current sheet selection. You need to use True for the first sheet, so it replaces the current sheet.
Function Save_PDF() As Boolean
Dim rng As Range, c As Range, replacePrevious As Boolean
Dim ws As Worksheet
With ThisWorkbook.Worksheets("Print Packages")
Set rng = .Range("E13:E" & .Cells(.Rows.Count, "E").End(xlUp).row)
replacePrevious = True 'first sheet repalces whatever is selected
For Each c In rng.Cells
Set ws = ThisWorkbook.Sheets(c.Value)
On Error Resume Next
ws.PageSetup.PrintQuality = 600
Err.Clear
On Error GoTo 0
ws.Select replacePrevious 'select the sheet
'switch to adding the sheet to the already-selected sheet(s)
replacePrevious = False
Next c
End With
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:= "yourFilePathHere", Quality:= xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Function