VBA - PDF two / three sheets

[j4ymf]

Hello

I have this code that we use to PDF a range within a sheet.
how would i change this code so i can PDF three sheets together .

Set invoiceRng = Range("A1:E60") sheet1
Set invoiceRng = Range("A1:E60") sheet2
Set invoiceRng = Range("A1:E60") sheet3

Sub PrintSelectionToPDF()
Dim invoiceRng As Range
Dim strfile As String
Set invoiceRng = Range("A1:E60")
'strfile = "" & " " & ("J.W. Simpkin Ltd Quotation") & ".pdf"
'strfile = ThisWorkbook.path & strfile

invoiceRng.ExportAsFixedFormat _
Type:=xlTypePDF, _
filename:=strfile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=True, _
OpenAfterPublish:=True
End Sub

 

[rlv01]

I think you may have to build a new range to export.
Partially tested:

Sub PrintSelectionToPDF()
    Dim invoiceRng As Range, destRng As Range
    Dim strfile As String
    Dim WS As Worksheet, WSTmp As Worksheet
    
'strfile = "" & " " & ("J.W. Simpkin Ltd Quotation") & ".pdf"
'strfile = ThisWorkbook.path & strfile
    
    With ThisWorkbook
        On Error Resume Next
        Application.DisplayAlerts = False
        .Worksheets("TempExportSheet").Delete
        Application.DisplayAlerts = True
        On Error Resume Next
    
        Set WSTmp = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
        WSTmp.Name = "TempExportSheet"
    
        For Each WS In .Worksheets
            Select Case WS.Name
            Case "Sheet1", "Sheet2", "Sheet3"         '<- sheet names to process
                If WSTmp.UsedRange.Cells.Count = 1 Then
                    Set destRng = WSTmp.Range("A1")
                End If
                WS.Range("A1:E60").Copy destRng
                Set destRng = WSTmp.Range("A" & WSTmp.Rows.Count).End(xlUp).Offset(1)
            End Select
        Next WS
    
        If WSTmp.UsedRange.Cells.Count > 1 Then
            Set invoiceRng = WSTmp.Range("A1", WSTmp.Range("A" & WSTmp.Rows.Count).End(xlUp))
        
        invoiceRng.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=strfile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=True, _
        OpenAfterPublish:=True
        Else
            .Worksheets(1).Activate
            MsgBox "Nothing to export", vbOKOnly
        End If
    End With
End Sub

 

[jolivanes]

Sub Or_Maybe_So()
Dim ts As String, shArr, i As Long
ts = ActiveSheet.Name
shArr = Array("Sheet2", "Sheet3", "Sheet4", "Sheet5")    '<----- Change as required
Sheets(shArr(i)).Select
ActiveSheet.PageSetup.PrintArea = "A1:E60"    '<----- Change as required
For i = LBound(shArr) + 1 To UBound(shArr)
    With Sheets(shArr(i))
        .PageSetup.PrintArea = "A1:E60"    '<----- Change as required
        .Select False
    End With
Next i
Application.Wait Now + TimeValue("00:00:03")    '<----- Delete this line. Just for my computer because of problems
    ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & UBound(shArr) + 1 & " Invoices" & ".pdf"    '<----- Change as required
Sheets(ts).Activate
End Sub

 

[j4ymf]

Hello rlv01. jolivanes

Thank you for your replies and your support
when try both surgestions it creates the temp file it dosen't expand the columns and looks squashed on the PDF any ideas

 

[j4ymf]

Hello rlv01. jolivanes

I think i may have cracked it as it was page 2 causing me the problems, ill come back if i need anymore help.

Thank you once again

 

[j4ymf]

Hello jolivanes

how would i change the code and set a different range per page?
IE: Sheet1 - PrintArea = "A1:E60"
sheet2 - PrintArea = A1:E40" etc

Sub Or_Maybe_So()
Dim ts As String, shArr, i As Long
ts = ActiveSheet.Name
shArr = Array("Sheet2", "Sheet3", "Sheet4", "Sheet5") '<----- Change as required
Sheets(shArr(i)).Select
ActiveSheet.PageSetup.PrintArea = "A1:E60" '<----- Change as required
For i = LBound(shArr) + 1 To UBound(shArr)
With Sheets(shArr(i))
.PageSetup.PrintArea = "A1:E60" '<----- Change as required
.Select False
End With
Next i
Application.Wait Now + TimeValue("00:00:03") '<----- Delete this line. Just for my computer because of problems
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & UBound(shArr) + 1 & " Invoices" & ".pdf" '<----- Change as required
Sheets(ts).Activate
End Sub

 

[jolivanes]

Please don't quote whole posts.
Refer to a Post number if needed.

The arrays are relevant to each other so the first item refers to the first item in the other array.
So item 3 in the rngArr is meant for the third item in the shArr
Made the code a little shorter also.

Dim ts As String, shArr, rngArr, i As Long
ts = ActiveSheet.Name
shArr = Array("Sheet2", "Sheet3", "Sheet4", "Sheet5") '<----- Change as required
rngArr = Array("A1:E30", "A1:E35", "A1:E40", "A1:E45") '<----- Change as required
Sheets(shArr(i)).Select
For i = LBound(shArr) To UBound(shArr)
    With Sheets(shArr(i))
        .PageSetup.PrintArea = rngArr(i)
        .Select False
    End With
Next i

The rest of the code is the same as before.

 

[Olov]

Please don't quote whole posts.
Refer to a Post number if needed.

The arrays are relevant to each other so the first item refers to the first item in the other array.
So item 3 in the rngArr is meant for the third item in the shArr
Made the code a little shorter also.

Dim ts As String, shArr, rngArr, i As Long
ts = ActiveSheet.Name
shArr = Array("Sheet2", "Sheet3", "Sheet4", "Sheet5") '<----- Change as required
rngArr = Array("A1:E30", "A1:E35", "A1:E40", "A1:E45") '<----- Change as required
Sheets(shArr(i)).Select
For i = LBound(shArr) To UBound(shArr)
    With Sheets(shArr(i))
        .PageSetup.PrintArea = rngArr(i)
        .Select False
    End With
Next i

The rest of the code is the same as before.

I have a question. How to do if a sheet is missing?