VBA 将活动 Sheet 上的可见单元格保存为 PDF

Question

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

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").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

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

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

VBA 将活动 Sheet 上的可见单元格保存为 PDF

VBA Save Visible Cells on Active Sheet as PDF

excel

vba

excel-2010

export-to-pdf