Excel 根据条件保存为PDF

我正在尝试开发以下项目：我有一个选择的工作表，在这个选择中，我想保存到一个pdf，只有那些单元格C8或C9填充的。 我设法使它只保存我的选择，但我无法添加此过滤器，以只保存这些单元格已填充的过滤器

你能帮我吗？ 这是我到目前为止的代码：

Sub Export_As_PDF()
Dim cx As Variant
Filename = Application.GetSaveAsFilename( _
 fileFilter:="PDF Files (*.pdf), *.pdf")
 If TypeName(Filename) = "Boolean" Then
MsgBox "Processo Cancelado."
Exit Sub
Else
CheckName = VBA.FileSystem.Dir(Filename)
 If CheckName = VBA.Constants.vbNullString Then
    C = Sheets(Array("Capa", "Aprovação","Receita","Anos")).Select
      For Each cx In C
        cx = Sheet(cx).Select
        If Not IsEmpty("C8") Or Not IsEmpty("D9") Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Filename, openafterpublish:=True, ignoreprintareas:=False
        ActiveWindow.Zoom = True
        MsgBox "Proposta Comercial Exportada para PDF."
        Else
        End If
      Next cx
  Else
    answer = MsgBox("The FileName already exists. Do you want to overwrite?", vbQuestion + vbYesNo)
     If answer = vbYes Then
        C = Sheets(Array("Capa", "Aprovação","Receita","Anos")).Select
        For Each cx In C
        If Not IsEmpty("C8") Or Not IsEmpty("D9") Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Filename, openafterpublish:=True, ignoreprintareas:=False
        ActiveWindow.Zoom = True
        MsgBox "Proposta Comercial Exportada para PDF."
        Else
        End If
        Next cx
      Else
        MsgBox "Proposta Cancelada."
        Exit Sub
      End If
  End If
End If
End Sub

---

尽量不要重复相同的代码。我删除了重复，这样更容易维护

这里的想法是循环浏览所有可能的工作表，检查每个工作表中的数据，并收集实际要导出的工作表的名称。然后仅选择这些图纸并将其导出

Option Explicit

Public Sub ExportAsPDF()
    Dim SaveToFilename As Variant
    SaveToFilename = Application.GetSaveAsFilename(FileFilter:="PDF Files (*.pdf), *.pdf")
    If VarType(SaveToFilename) = vbBoolean Then
        MsgBox "Processo Cancelado."
        Exit Sub
    End If  ' no else needed as you exit anyway if it is true
    
    ' check if file exists and ask for overwrite
    Dim CheckName As String
    CheckName = VBA.FileSystem.Dir(SaveToFilename)
    If Not CheckName = VBA.Constants.vbNullString Then
        Dim Answer As Long
        Answer = MsgBox("The FileName already exists. Do you want to overwrite?", vbQuestion + vbYesNo)
        If Not Answer = vbYes Then
            MsgBox "Proposta Cancelada."
            Exit Sub
        End If
    End If
    
    
    On Error GoTo SHEET_NOT_FOUND ' if one of the sheets does not exist error
    Dim PossibleSheets As Sheets
    Set PossibleSheets = Sheets(Array("Capa", "Aprovação", "Receita", "Anos"))
    On Error GoTo 0
    
    
    Dim ExportSheetNames As Collection
    Set ExportSheetNames = New Collection
    
    ' Check if data exists and collect all sheet names with data
    Dim Sheet As Variant
    For Each Sheet In PossibleSheets
        If Not IsEmpty(Sheet.Range("C8")) Or Not IsEmpty(Sheet.Range("D9")) Then
            ExportSheetNames.Add Sheet.Name, Sheet.Name
        End If
    Next Sheet
    
    ' Convert collection into array beacause Sheets() needs an array
    Dim ExportSheets() As String
    ReDim ExportSheets(0 To ExportSheetNames.Count - 1) As String
    Dim i As Long
    For i = 0 To ExportSheetNames.Count - 1
        ExportSheets(i) = ExportSheetNames.Item(i + 1)
    Next i
    
    ' Export
    Sheets(ExportSheets).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=SaveToFilename, openafterpublish:=True, ignoreprintareas:=False
    
    MsgBox "Proposta Comercial Exportada para PDF."
    
    ' Error handling
    Exit Sub
SHEET_NOT_FOUND:
    MsgBox "One sheet was not found."
End Sub

---

您的代码无法编译，更不用说工作了。您应该做的第一件事是将Option显式放在模块顶部，然后声明所有变量。然后第19行cx=工作表（cx）。选择需要读取cx=工作表（cx）。选择。这仍然是错误的，但至少它会编译。继续从主菜单中点击“调试/编译”，直到代码编译无误。也许我们可以帮你修正逻辑。