excel - VBA 将活动工作表上的可见单元格另存为 PDF
问题描述
我有一个可以成功运行的代码,但我想对其进行扩展,以便它只导出可见单元格。当它运行时,它会根据需要保存 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
我使用了以前构建的代码中的位,但我不知道如何实现此更改。任何帮助将不胜感激。
解决方案
请尝试实施下一种方式。它使用一个新的辅助表,将不连续的范围复制到那里(作为连续的),导出此表并在之后将其删除:
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
推荐阅读
- azure - 无法查询可用的提供程序包
- python - python中sympy中微分的数值
- django - Django 设置的 Amazon S3 存储桶配置问题。
AccessDenied
- nginx - 为 Nginx 执行这种重写和代理传递的正确方法是什么?
- c - 在不更改新创建的数组的值时,我是否遇到了需求分页?
- sqlalchemy - 在 fastapi sqlalchemy 会话中,列表追加不起作用
- python - Flask 中的@app.route 和@app.get 有什么区别?
- python - Django 在 url 中添加了一个额外的“/”?
- php - Laravel Passport - 无法获得令牌字符串作为响应?
- javascript - 在 Reactjs 中提交时防止表单刷新