Question

我试图根据单元格 E22、E24、E26、E28、E30 在“Front Sheet”= 1 上是否将各种工作表上的某些范围输出到 pdf 并且它会输出工作表“Front Sheet,Dimension Report,Drawing,Dimension打印输出、HFQ 报告、硬度数据”，因此如果 E22 =1 它将输出“Front Sheet”，如果 E22 = 1 那么它会输出“Dimension Report”但如果 E26 没有 = 1 那么它会忽略该页面但仍然输出剩下的

在我当前的代码中，我收到一个运行时错误 9. 我不知道如何解决这个问题

Private Sub CommandButton1_Click()

    Const cESheets As String = "Front Sheet,Dimension Report,Drawing,Dimension Printout, HFQ Report,Hardness Data"
    Const cSheet As String = "Front Sheet"
    Const cRange As String = "E22,E24,E26,E28,E30"
    Const cCrit As Long = 1

    Dim wb As Workbook
    Dim Cell As Range
    Dim vntS As Variant
    Dim iFound As Long

    ' **********************************
    ' Copy Sheets to New workbook.
    ' **********************************

    
    vntS = Split(cESheets, ",")

    
    With ThisWorkbook
        For Each Cell In .Worksheets(cSheet).Range(cRange)
            If Cell.Value = cCrit Then
                iFound = iFound + 1
                If iFound = 1 Then
                    .Sheets(Trim(vntS(iFound - 1))).Copy
                    Set wb = ActiveWorkbook
                  Else
                    .Sheets(Trim(vntS(iFound - 1))).Copy _
                            After:=wb.Sheets(wb.Sheets.Count)
                End If
              'Else
            End If
        Next
    End With

    ' **********************************
    ' Export New Workbook to PDF
    ' **********************************

    If iFound = 0 Then Exit Sub


    With wb
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:="Exported.pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=True
        .Close False
    End With

End Sub

我在以下位置收到运行时错误 9：

Else
                    .Sheets(Trim(vntS(iFound - 1))).Copy _
                            After:=wb.Sheets(wb.Sheets.Count)

我对 VBA 还很陌生，所以无论如何都需要帮助。

Answer 1

根据单元格值导出为 PDF

调整常量部分中的值。
除非没有单元格包含条件值（不会发生任何事情），否则第一个工作表和找到条件值的每个单元格指定的工作表将被复制。

代码

Option Explicit

Private Sub CommandButton1_Click()

    Const cESheets As String = "Sheet1,Sheet2,Sheet3,Sheet4,Sheet5,Sheet6"
    Const cSheet As String = "Sheet1"
    Const cRange As String = "E22,E24,E26,E28,E30"
    Const cCrit As Long = 1

    Dim dwb As Workbook
    Dim sws As Worksheet
    Dim Cell As Range
    Dim vntS() As String
    Dim iFound As Long

    
    vntS = Split(cESheets, ",")
    
    Set sws = ThisWorkbook.Worksheets(Trim(vntS(0)))
    
    ' Sum is incorrect, and CountIf doesn't work on non-contiguous cells.
    For Each Cell In sws.Range(cRange).Cells
        If Cell.Value = cCrit Then
            iFound = 1
            Exit For
        End If
    Next Cell
    If iFound = 0 Then Exit Sub
    
    ' **********************************
    ' Copy Sheets to New workbook.
    ' **********************************
    
    Application.ScreenUpdating = False
    
    sws.Copy
    Set dwb = ActiveWorkbook
    iFound = 0
    
    For Each Cell In sws.Range(cRange).Cells
        iFound = iFound + 1
        If Cell.Value = cCrit Then
            sws.Parent.Worksheets(Trim(vntS(iFound))).Copy _
                After:=dwb.Sheets(dwb.Sheets.Count)
        End If
    Next

    ' **********************************
    ' Export New Workbook to PDF
    ' **********************************

     With dwb
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:="Exported.pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=True
        .Close False
    End With

    Application.ScreenUpdating = True

End Sub

VBA 将基于单元格值的特定工作表导出为 PDF

1 个答案:

根据单元格值导出为 PDF