【问题标题】:How to generate PDF from specific sheet based on cell value?如何根据单元格值从特定工作表生成 PDF?
【发布时间】:2021-03-02 21:05:06
【问题描述】:

我正在尝试根据该工作表在 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

【问题讨论】:

    标签: excel vba pdf-generation


    【解决方案1】:

    为了使答案更完整,我重构了您的代码(尽管有待改进)

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

    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
    

    注意:我发现的一件事是您没有定义输出文件的名称,所以我用一个变量(固定)设置它。如果您需要工作表名称之类的内容,则代码需要一个小时间

    让我知道它是否有效!

    【讨论】:

    • 非常感谢您的帮助 - 这非常有效!我只需要再添加几张工作表,因为这些工作表可以工作 :-) 这是我的 B 计划的一个更好的解决方案,如果我无法使其工作,则为每张工作表设置一个按钮!
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2019-11-02
    • 2019-08-13
    • 2019-02-22
    • 1970-01-01
    • 1970-01-01
    • 2022-01-28
    相关资源
    最近更新 更多