将多个 Excel 工作表范围转换为 PDF VBA

Question

The below code is take the Status of Col"E" If it is = Include then its corresponding sheets ranges will will be converted to PDF.

I have tried at my end but its not working receiving an error invalid procedure call or argument on the line

rng.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=saveLocation

Your help will be appreciated to fix the problem.

Sub SelectSheets_Ranges()

  Dim sh As Worksheet, lastR As Long, rng As Range, arr, arrSplit, i As Long, k As Long
  
  Set sh = ActiveSheet
  lastR = sh.Range("C" & sh.Rows.Count).End(xlUp).Row
  
  ReDim arr(lastR - 1)
  For i = 6 To lastR
        If sh.Range("E" & i).Value = "Include" Then
            arr(k) = sh.Range("C" & i).Value & "|" & sh.Range("D" & i).Value: k = k + 1
        End If
  Next i
  ReDim Preserve arr(k - 1)
  For i = 0 To UBound(arr)
        arrSplit = Split(arr(i), "|")
        Set rng = Worksheets(arrSplit(0)).Range(arrSplit(1))


'Create and assign variables
Dim saveLocation As String

saveLocation = "C:\Users\marks\OneDrive\Documents\myPDFFile.pdf"

'Save a range as PDF
rng.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=saveLocation

  
  Next
End Sub

Answer 1

Please, try the next code. It saves in ThisWorkbook path, naming the pdf file as "myPDFFile_sheetName.pdf". Each created file will be open in the default pdf application. If it works OK, you can appropriately change the last parameter:

Sub SelectSheets_Ranges_ExpPdf()
  Dim sh As Worksheet, lastR As Long, rng As Range, arr, arrSplit, i As Long, k As Long
  
  Set sh = ActiveSheet
  lastR = sh.Range("C" & sh.Rows.Count).End(xlUp).Row
  
  ReDim arr(lastR - 1)
  For i = 6 To lastR
        If sh.Range("E" & i).Value = "Include" Then
            arr(k) = sh.Range("C" & i).Value & "|" & sh.Range("D" & i).Value: k = k + 1
        End If
  Next i
  If k > 0 Then
        ReDim Preserve arr(k - 1)
  Else
        MsgBox "No appropriate range (containing ""Include"") could be found...:exit sub"
  End If
  Dim boolHide As Boolean, boolProt As Boolean
  ActiveWorkbook.Unprotect "4321" 'in order to unprotect he workbook structure
  For i = 0 To UBound(arr)
        boolHide = False: boolProt = False
        arrSplit = Split(arr(i), "|")
        Set rng = Worksheets(arrSplit(0)).Range(arrSplit(1))
        
        If ActiveWorkbook.Sheets(arrSplit(0)).ProtectContents Then _
                ActiveWorkbook.Sheets(arrSplit(0)).Unprotect "4321": boolProt = True
                Debug.Print arrSplit(0)
        If ActiveWorkbook.Sheets(arrSplit(0)).Visible <> xlSheetVisible Then _
                ActiveWorkbook.Sheets(arrSplit(0)).Visible = xlSheetVisible: boolHide = True
        
        'Create and assign variables
        Dim saveLocation As String
        
        saveLocation = ThisWorkbook.Path & "\myPDFFile_" & arrSplit(0) & ".pdf"
        
        'Save a range as PDF
        rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
          saveLocation, Quality:=xlQualityStandard, IgnorePrintAreas:=False, OpenAfterPublish:=True
         If boolHide Then ActiveWorkbook.Sheets(arrSplit(0)).Visible = xlSheetHidden
         If boolProt Then ActiveWorkbook.Sheets(arrSplit(0)).Protect "4321"
  Next
  ActiveWorkbook.Protect "4321"
End Sub

Answer 2

Try this:

Sub SelectSheets_Ranges()

    Dim sh As Worksheet, i As Long
    Dim saveLocation As String, FirstSheet As Boolean
    
    saveLocation = "C:\Users\marks\OneDrive\Documents\myPDFFile.pdf"
    
    Set sh = ActiveSheet
    FirstSheet = True
    For i = 6 To sh.Range("C" & sh.Rows.Count).End(xlUp).Row
        If sh.Cells(i, "E") = "Include" Then
            'FirstSheet determines whether the sheet is added to currently-selected 
            '  sheets or not (if not then it replaces them)
            ThisWorkbook.Sheets(sh.Cells(i, "C").Value).Select FirstSheet
            FirstSheet = False
        End If
    Next i
    If Not FirstSheet Then
        'at least one sheet was included
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation
    End If
    
End Sub

Answer 3

I assume you want all the ranges from the different sheets in one pdf.

Option Explicit

Sub SelectSheets_Ranges()

    Const FOLDER = "C:\Users\marks\OneDrive\Documents\"
    Const FILENAME = "myPDFFile.pdf"

    Dim wb As Workbook, wbPDF As Workbook
    Dim sh As Worksheet, wsPDF As Worksheet
    Dim lastR As Long, rng As Range, r As Long, n As Integer, m As Integer
    
    Set sh = ActiveSheet
    Set wb = ActiveWorkbook
    lastR = sh.Range("C" & sh.Rows.Count).End(xlUp).Row
    
    ' create temp workbook to hold ranges
    Set wbPDF = Workbooks.Add
    m = wbPDF.Sheets.Count
    n = m
    With sh
        For r = 6 To lastR
            If .Cells(r, "E").Value = "Include" Then
                Set rng = wb.Sheets(.Cells(r, "C").Value).Range(.Cells(r, "D").Value)
                Set wsPDF = wbPDF.Sheets.Add(After:=wbPDF.Sheets(n))
                rng.Copy wsPDF.Range("A1")
                n = n + 1
            End If
        Next
    End With

    ' delete initial sheets
    Application.DisplayAlerts = False
    For n = m To 1 Step -1
       wbPDF.Sheets(n).Delete
    Next
    Application.DisplayAlerts = True
    
    'end
    wbPDF.ExportAsFixedFormat Type:=xlTypePDF, FILENAME:=FOLDER & FILENAME
    'wbPDF.SaveAs FOLDER & "debug.xlsx"
    wbPDF.Close False
    MsgBox "PDF created " & FOLDER & FILENAME, vbInformation

End Sub