VBA 将活动工作表上的可见单元格另存为 PDF

Question

我有一个可以成功运行的代码，但我想对其进行扩展，使其仅导出可见单元格。当它运行时，它会根据需要保存 PDF，但 PDF 有很多空白空间。

Sub OrderFormHide()

    Worksheets("Order Form").Unprotect "!Product1@"
    
'AutoFit All Columns on Worksheet
ThisWorkbook.Worksheets("Order Form").Cells.EntireRow.AutoFit
Application.ScreenUpdating = False

'Hide rows with no data requirements
Dim c As Range
For Each c In Range("A:A")
    If InStr(1, c, "DELETE") Or InStr(1, c, "DELETE") Then
            c.EntireRow.Hidden = True
        ElseIf InStr(1, c, "") Or InStr(1, c, "") Then
            c.EntireRow.Hidden = False
    End If
    Next
    
    Worksheets("Order Form").Protect "!Product1@"
    

Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim MyFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strDate = Format(Now(), "ddmmyyyy")
strC = Worksheets("Start Page").Range("$C$10").Value



'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for saving file
strFile = strName & "_" & strC & "_" & strDate & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
MyFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If MyFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=MyFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & MyFile
End If

 exitHandler:
    Exit Sub
 errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
    
Application.ScreenUpdating = True

End Sub

我使用了以前构建的代码中的位，但我不知道如何实现此更改。任何帮助将不胜感激。

Answer 1

请尝试实施下一种方法。它使用一个新的辅助表，将不连续的范围复制到那里（作为连续的），导出此表并在之后将其删除：

Sub testExportVisibleCellsRange()
  Dim sh As Worksheet, shNew As Worksheet, rngVis As Range, strPDF As String
  
  strPDF = ThisWorkbook.path & "\testVisible.pdf"
  Set sh = ActiveSheet 'use here the necessary sheet
  
  Set rngVis = sh.UsedRange.SpecialCells(xlCellTypeVisible)

  Set shNew = Worksheets.Add(After:=sh)
  rngVis.Copy shNew.Range("A1")
  shNew.UsedRange.EntireColumn.AutoFit
  With shNew.PageSetup
      .Orientation = xlPortrait
      .FitToPagesWide = 1
  End With
  shNew.ExportAsFixedFormat Type:=xlTypePDF, fileName:=strPDF
  Application.DisplayAlerts = False
    shNew.Delete
  Application.DisplayAlerts = True
End Sub