Блог

У меня есть код, который успешно работает, но я хотел бы расширить его, чтобы он экспортировал только видимые ячейки. При запуске он сохраняет 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 amp; ""

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

'create default name for saving file
strFile = strName amp; "_" amp; strC amp; "_" amp; strDate amp; ".pdf"
strPathFile = strPath amp; 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: " _
      amp; vbCrLf _
      amp; MyFile
End If

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

End Sub
 

Я использовал фрагменты из предыдущих созданных мной кодов, но не могу понять, как реализовать это изменение. Любая помощь будет очень признательна.

Пожалуйста, попробуйте реализовать следующий способ. Он использует новый вспомогательный лист, копирует туда прерывистый диапазон (как непрерывный), экспортирует этот лист и удаляет его после:

 Sub testExportVisibleCellsRange()
  Dim sh As Worksheet, shNew As Worksheet, rngVis As Range, strPDF As String
  
  strPDF = ThisWorkbook.path amp; "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