excel - 如何根据单元格值从特定工作表生成 PDF？

Question

我正在尝试根据该工作表在 A1 中是否具有 1 从单个工作表（在一个工作簿中）生成单个 PDF。根据前页（“计算器”/“Sheet1”）上填写的内容，10 个隐藏工作表中只有一个会在 A1 中显示 1。

我拥有的代码确实会生成 PDF，但不会更改活动工作表，因此它不会跳转到 A1 中的 1 的工作表实例，而是打印我上次使用的工作表。

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

标签： excelvbapdf-generation

Answer 1

为了使答案更完整，我重构了您的代码（尽管可以改进）

阅读评论并根据您的需要进行调整

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 https://stackoverflow.com/a/25715352/1521579
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

注意：我发现的一件事是你没有定义输出文件的名称，所以我用一个变量（固定）设置它。如果您需要工作表名称之类的内容，则代码需要一个小的 tweek

让我知道它是否有效！