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
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
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
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.