仅将填充单元格的填充电子表格保存为 PDF

Question

我目前正在尝试修改 Visual Basic 宏以仅将电子表格保存在已填充单元格的工作簿中。

当前的宏只是将整个 16 张工作簿保存为 PDF，但有时最多有 9 张未完成，但仍被保存。

我希望宏在单击“保存”按钮后自动检查这些工作表是否已填充，然后继续仅将填写的（完整）工作表保存为 PDF。

我会非常感谢任何帮助！

下面的代码是宏在保存整个工作簿时当前的工作方式。 （在保存为 PDF 之前有一个 IF 语句检查。）

Sub SaveAsPDF()

    With ThisWorkbook.Sheets("COVERPage1PRINT")
        If (Len(.Range("C24")) = 0) Then
            MsgBox "Ensure Serial Number or Stamp number are filled."
            Exit Sub
        ElseIf (Len(.Range("H17")) = 0) Then
            MsgBox "Ensure Serial Number or Stamp Number are filled."
            Exit Sub

        Else
            ChDir _
            "P:\Cells\Spool & Sleeves Cell\Flow Plot Records\EFA\Saved EFA PDF Archive"
        fname = Sheets("COVERPage1PRINT").Range("H17")
        ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "P:\Cells\Spool & Sleeves Cell\Flow Plot Records\EFA\Saved EFA PDF Archive\" & fname, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=True

        End If
    End With
End Sub

Answer 1

这将在一定程度上取决于您所说的“自动检查这些工作表是否已被填充”的确切含义。我的水晶球说每个工作表都有一个标题行，如果第一行下方有任何数据，则将被视为“已填充”。在这种情况下，您可以循环浏览所有工作表并构造一组要选择的工作表名称。一旦选择了多个工作表，PDF 创建将在 ActiveSheet.ExportAsFixedFormat 而不是 ActiveWorkbook.ExportAsFixedFormat 上，并且只有那些选择的工作表才会包含在 PDF 中。

Dim w As Long, sWSs As String, vWSs As Variant
For w = 1 To Sheets.count
    With Sheets(w)
        If .Cells(1, 1).CurrentRegion.Rows.count > 1 Then _
            sWSs = sWSs & .Name & Chr(215)
    End With
Next w
If CBool(Len(sWSs)) Then
    vWSs = Split(Left(sWSs, Len(sWSs) - 1), Chr(215))
    Sheets(vWSs).Select
    ChDir _
        "P:\Cells\Spool & Sleeves Cell\Flow Plot Records\EFA\Saved EFA PDF Archive"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "P:\Cells\Spool & Sleeves Cell\Flow Plot Records\EFA\Saved EFA PDF Archive\" & fname, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Else
    MsgBox "Nothing to publish to PDF."
End If

我已经用我自己的示例工作簿对此进行了测试，然后尝试将您的代码示例细节合并到我的方法中。如果第一次发回评论不起作用，我也许可以提供帮助。

Answer 2

这应该可以完成工作 （编辑代码）

Sub test1()

Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim test() As String
Dim i As Integer
Dim pdfpath As String
Dim sheets_to_be_checked() As Variant
Dim a As Boolean
pdfpath = ActiveWorkbook.Path 'YOU CAN ADD YOUR PDF SAVING LOCATION e.g. "C\Users\ABC\Desktop"

i = 0
sheets_to_be_checked = Array("Sheet1", "Sheet3")
Set wbBook = ActiveWorkbook

With ThisWorkbook.Sheets("COVERPage1PRINT")
    If (Len(.Range("C24")) = 0) Then
        MsgBox "Ensure Serial Number & Tag Number or Stamp number are filled."
        Exit Sub
    ElseIf (Len(.Range("H16")) = 0) Then
        MsgBox "Ensure Serial Number & Tag Number or Stamp Number are filled."
        Exit Sub
    ElseIf (Len(.Range("H19")) = 0) Then
        MsgBox "Ensure Serial Number & Tag Number or Stamp Number are filled."
        Exit Sub
    Else:
        For Each wsSheet In wbBook.Worksheets
            With wsSheet
                If IsInArray(wsSheet.Name, sheets_to_be_checked) Then
                    wsSheet.Activate
                    If WorksheetFunction.CountA(Range("D4:D9, E10:E15, F4:F9, G10:G15, H4:H9, I10:I15, J4:J9, K10:K15")) = 48 Then
                        ReDim Preserve test(i)
                        test(i) = wsSheet.Name
                        i = i + 1
                    End If
                Else:
                    ReDim Preserve test(i)
                    test(i) = wsSheet.Name
                    i = i + 1
                End If
            End With
        Next wsSheet
    End If
End With

ThisWorkbook.Sheets(test()).Select

ActiveSheet.ExportAsFixedFormat _
     Type:=xlTypePDF, _
     Filename:=pdfpath & "\ouput.pdf", _
     Quality:=xlQualityStandard, _
     IncludeDocProperties:=True, _
     IgnorePrintAreas:=False, _
     OpenAfterPublish:=True
End Sub


Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
  IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

根据您对填充工作表的定义，答案可能会有所不同。您必须更改条件 "If .UsedRange.Address "$A$1" Then " 一种可能的替代方法是 WorksheetFunction.CountA(Range("A1:Z100")) 0

如果您在条件或代码方面需要任何帮助，请告诉我。