只能将填充的单元格填充为PDF

我目前正在尝试修改一个Visual Basicmacros只保存工作簿中已经填充单元格的电子表格。

当前的macros只是将整个16页工作簿保存为PDF格式，但最多9个这样的页面有时仍未完成，但仍保存。

我希望macros自动检查这些表是否已经填充，一旦点击“保存”button，然后继续只保存填写（完整）表作为PDF。

我会大量appricate任何帮助！

下面的代码是macros保存整个工作簿时的工作方式。 （在保存为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

这应该做的工作（编辑代码）

 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 eg "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“然后”上面的一个可能的替代是WorksheetFunction.CountA（Range（“A1：Z100”））<> 0

请让我知道，如果你需要任何协助的条件或代码。

Answer 2

这将取决于“自动检查这些表是否已填充” 。 我的水晶球说每个工作表都有一个标题行，如果第一行下面有任何数据，就会被认为是“填充的”。 在这种情况下，您可以遍历所有工作表并构build要select的工作表名称数组。 一旦select了多个工作表，PDF创build将在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 

我已经用我自己的示例工作簿testing了这个，然后尝试将您的代码示例细节合并到我的方法中。 如果第一次发表评论无效，我可能会提供帮助。