如何根据单元格值从特定 sheet 生成 PDF?
How to generate PDF from specific sheet based on cell value?
我正在尝试根据 sheet 在 A1 中是否有 1,从单个 sheet(在一个工作簿中)生成单个 PDF。 10 个隐藏的 sheet 中只有一个会在 A1 中显示为 1,具体取决于前面填写的内容 sheet(“计算器”/“工作表 1”)。
我的代码确实会生成 PDF 但不会更改活动 sheet,因此它不会跳转到 A1 中带有 1 的 sheet 的实例,而是打印 sheet 我是最后一个。
Sub GenPDF_OTJ()
Dim saveInFolder As String
Dim replaceSelected As Boolean
Dim wsName As Variant
Dim iVis As XlSheetVisibility
saveInFolder = "C:\Downloads\pdf\"
If Right(saveInFolder, 1) <> "\" Then saveInFolder = saveInFolder & "\"
With ThisWorkbook
replaceSelected = True
For Each wsName In Array("OTJ Bus Admin", "OTJ SFSCA", "OTJ Sales L4") 'additional sheets to be added in once working
If .Worksheets(wsName).Range("A1").Value > 0 Then 'A1 will only be 1 or 0
.Worksheets(wsName).Select replaceSelected
replaceSelected = False
End If
Next
.ActiveSheet.Select
With .ActiveSheet
iVis = .Visible
.Visible = xlSheetVisible
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PdfFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
.Visible = iVis
.Visible = xlSheetHidden
End With
End With
End Sub
为了使答案更完整,我重构了您的代码(尽管有待改进)
阅读评论并根据您的需要进行调整
Option Explicit
Public Sub GenPDF_OTJ()
'''''''''' Adjust values below ''''''''''
' Define folder to save in
Dim saveInFolder As String
saveInFolder = "C:\Temp\"
' Define output file name
Dim outputFileName As String
outputFileName = "Test.pdf" ' Include extension
' Define sheets to print list (array)
Dim sheetsToPrintNames As Variant
sheetsToPrintNames = Array("OTJ Bus Admin", _
"OTJ SFSCA", _
"OTJ Sales L4")
' Define cell address to check in each sheet
Dim cellAddressToCheck As String
cellAddressToCheck = "A1"
' Define cell value to check (if true, prints the sheet)
Dim cellValueToPrint As Long ' Use Long if is an integer number or decimal or double search in google for vba variable types)
cellValueToPrint = 1
'''''''''' Adjust values above ''''''''''
'''''''''' Code logic below ''''''''''
' Add backslash if it's missing
If Right(saveInFolder, 1) <> "\" Then saveInFolder = saveInFolder & "\"
' Define target workbook
Dim targetWorkbook As Workbook
Set targetWorkbook = ThisWorkbook ' You could change this to Workbooks("SomeOtherWorkbookName")
' Review each sheet and print to pdf if condition is met
Dim targetSheet As Worksheet
For Each targetSheet In targetWorkbook.Worksheets
' If condition is met, then print sheet
If targetSheet.Range(cellAddressToCheck).Value = cellValueToPrint Then
' Build output file path
Dim outputFilePath As String
outputFilePath = saveInFolder & outputFileName
' Check if target file exists
If Len(Dir(outputFilePath)) <> 0 Then
' Check if target file is locked
If IsFileOpen(outputFilePath) = True Then
MsgBox "Output file is locked, close it and retry (cancelling process)"
Exit Sub
End If
End If
' Get target sheet visibility
Dim targetSheetVisibility As XlSheetVisibility
targetSheetVisibility = targetSheet.Visible
' Force sheet to be visible
targetSheet.Visible = xlSheetVisible
targetSheet.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=outputFilePath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
' Return sheet visibility to previous state
targetSheet.Visible = targetSheetVisibility
End If
Next targetSheet
End Sub
' Credits to Siddhart
Private Function IsFileOpen(ByVal FileName As String) As Boolean
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error ErrNo
End Select
End Function
注意:我发现的一件事是你没有定义输出文件的名称,所以我用一个变量(固定的)设置它。如果你需要像 sheet 的名字这样的东西,代码需要一个小的 tweek
如果有效请告诉我!
我正在尝试根据 sheet 在 A1 中是否有 1,从单个 sheet(在一个工作簿中)生成单个 PDF。 10 个隐藏的 sheet 中只有一个会在 A1 中显示为 1,具体取决于前面填写的内容 sheet(“计算器”/“工作表 1”)。
我的代码确实会生成 PDF 但不会更改活动 sheet,因此它不会跳转到 A1 中带有 1 的 sheet 的实例,而是打印 sheet 我是最后一个。
Sub GenPDF_OTJ()
Dim saveInFolder As String
Dim replaceSelected As Boolean
Dim wsName As Variant
Dim iVis As XlSheetVisibility
saveInFolder = "C:\Downloads\pdf\"
If Right(saveInFolder, 1) <> "\" Then saveInFolder = saveInFolder & "\"
With ThisWorkbook
replaceSelected = True
For Each wsName In Array("OTJ Bus Admin", "OTJ SFSCA", "OTJ Sales L4") 'additional sheets to be added in once working
If .Worksheets(wsName).Range("A1").Value > 0 Then 'A1 will only be 1 or 0
.Worksheets(wsName).Select replaceSelected
replaceSelected = False
End If
Next
.ActiveSheet.Select
With .ActiveSheet
iVis = .Visible
.Visible = xlSheetVisible
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PdfFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
.Visible = iVis
.Visible = xlSheetHidden
End With
End With
End Sub
为了使答案更完整,我重构了您的代码(尽管有待改进)
阅读评论并根据您的需要进行调整
Option Explicit
Public Sub GenPDF_OTJ()
'''''''''' Adjust values below ''''''''''
' Define folder to save in
Dim saveInFolder As String
saveInFolder = "C:\Temp\"
' Define output file name
Dim outputFileName As String
outputFileName = "Test.pdf" ' Include extension
' Define sheets to print list (array)
Dim sheetsToPrintNames As Variant
sheetsToPrintNames = Array("OTJ Bus Admin", _
"OTJ SFSCA", _
"OTJ Sales L4")
' Define cell address to check in each sheet
Dim cellAddressToCheck As String
cellAddressToCheck = "A1"
' Define cell value to check (if true, prints the sheet)
Dim cellValueToPrint As Long ' Use Long if is an integer number or decimal or double search in google for vba variable types)
cellValueToPrint = 1
'''''''''' Adjust values above ''''''''''
'''''''''' Code logic below ''''''''''
' Add backslash if it's missing
If Right(saveInFolder, 1) <> "\" Then saveInFolder = saveInFolder & "\"
' Define target workbook
Dim targetWorkbook As Workbook
Set targetWorkbook = ThisWorkbook ' You could change this to Workbooks("SomeOtherWorkbookName")
' Review each sheet and print to pdf if condition is met
Dim targetSheet As Worksheet
For Each targetSheet In targetWorkbook.Worksheets
' If condition is met, then print sheet
If targetSheet.Range(cellAddressToCheck).Value = cellValueToPrint Then
' Build output file path
Dim outputFilePath As String
outputFilePath = saveInFolder & outputFileName
' Check if target file exists
If Len(Dir(outputFilePath)) <> 0 Then
' Check if target file is locked
If IsFileOpen(outputFilePath) = True Then
MsgBox "Output file is locked, close it and retry (cancelling process)"
Exit Sub
End If
End If
' Get target sheet visibility
Dim targetSheetVisibility As XlSheetVisibility
targetSheetVisibility = targetSheet.Visible
' Force sheet to be visible
targetSheet.Visible = xlSheetVisible
targetSheet.ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=outputFilePath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
' Return sheet visibility to previous state
targetSheet.Visible = targetSheetVisibility
End If
Next targetSheet
End Sub
' Credits to Siddhart
Private Function IsFileOpen(ByVal FileName As String) As Boolean
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error ErrNo
End Select
End Function
注意:我发现的一件事是你没有定义输出文件的名称,所以我用一个变量(固定的)设置它。如果你需要像 sheet 的名字这样的东西,代码需要一个小的 tweek
如果有效请告诉我!