Only save populated spreadsheets with filled in cells as PDF

问题

I'm currently trying to modify a Visual Basic macro to only save spreadsheets in a workbook that have had populated cells.

The current macro just saves the entire 16 sheet workbook as a PDF yet a maximum of 9 of these sheets are sometimes left uncompleted, yet are still saved.

I would like the macro to automatically check if these sheets have been populated, once the 'SAVE' button is clicked and then proceed to only save the filled out (complete) sheets as a PDF.

I would massively appricate any help!

The code below is how the macro currently works when just saving the entire workbook. (There is an IF statement check before it is saved to PDF.)

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

回答1:

This should do the job (edited code)

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

The answer might change a little depending on your definition of populated sheets. You would have to alter the condition "If .UsedRange.Address <> "$A$1" Then " One possible alternative to above is WorksheetFunction.CountA(Range("A1:Z100")) <> 0

Please let me know if you need any assistance with the condition or the code.

回答2:

This is going to depend somewhat on what exactly you mean by 'automatically check if these sheets have been populated'. My crystal ball says that each worksheet has a header row and would be considered 'populated' if there was any data below the first row. In that case, you could cycle through all worksheets and construct an array of worksheet names to be selected. Once multiple worksheets are selected, the PDF creation would be on ActiveSheet.ExportAsFixedFormat not ActiveWorkbook.ExportAsFixedFormat and only those worksheets selected would be included in the 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

I've tested this with my own sample workbook then tried to incorporate your code sample specifics into my method. If it doesn't work the first time post back a comment and I may be able to offer assistance.

来源：https://stackoverflow.com/questions/26234627/only-save-populated-spreadsheets-with-filled-in-cells-as-pdf