只保存已填充单元格的填充电子表格为PDF

Question

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

当前宏只是将整个16工作簿保存为PDF，但最多9个这些工作表有时会保留未完成状态，但仍然保存。

我希望宏自动检查这些表是否已经填充，一旦点击'保存'按钮，然后继续只保存填充（完整）工作表为PDF。

我会大规模appricate任何帮助！

下面的代码是宏保存整个工作簿时当前的工作方式。 （有一个IF语句检查之前将其保存为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 

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 

答案可能会改变一点取决于你的填充纸张定义。你将不得不改变条件 “如果.UsedRange.Address <> ”$ A $ 1“，则” 一种可能的替代以上WorksheetFunction.CountA（范围（ “A1：Z100”））<> 0

请让我知道你是否需要任何协助的条件或代码。