如何将特定页面从单个 sheet 导出为 pdf?
How to export a specific page from a single sheet to pdf?
我正在尝试添加一个按钮,该按钮提示用户输入页码 FROM 和 TO 并将该特定页面保存为 pdf。
这是我用来保存为 pdf 的代码。
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
**From:=2, To:=2**, _
OpenAfterPublish:=True
'confirmation message with file info
MsgBox "PDF file has been saved."
End If
您可以尝试添加这些行:
Dim sheetNbr as integer
sheetNbr = InputBox ("Please input sheet number to export")
Set wsA = wbA.Sheets(sheetNbr)
现在在 wsA 下应该有对特定工作表编号的引用。
我的旧答案是不必要的。也许我误解了你的问题。 ExportAsFixedFormat 已经有 "To" & "From" 参数。所以,使用自定义代码来创建相同的东西是没有意义的。
新答案:
I am trying to add a button where the button prompts user to enter a page number FROM AND TO and save that specific page to pdf.
我想您所需要的只是一种请求用户输入的方法。在这种情况下,使用此代码:
Sub AskForPages()
Dim PageFromStr As String, PageToStr As String, ExportFullName As String
ExportFullName = ThisWorkbook.Path & "\Test.pdf"
PageFromStr = InputBox("Insert the number of the first page to export.")
'Validate the input to be a positive number.
If IsNumeric(PageFromStr) Then
If PageFromStr < 1 Then Beep: Exit Sub
Else
Beep
Exit Sub
End If
PageToStr = InputBox("Inster the number of the last page to export.")
'Validate the input to be a number greater than the "From".
If IsNumeric(PageToStr) Then
If PageToStr < PageFromStr Then Beep: Exit Sub
Else
Beep
Exit Sub
End If
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=ExportFullName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
From:=PageFromStr, To:=PageToStr, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub
旧答案:
您可以使用此子(传递要打印的页码(从和到))来执行此操作:
Sub PrintPages(FromPageNum As Long, ToPageNum As Long, ExportFullName as string)
Dim Rng As Range, i As Long
If FromPageNum > ToPageNum Then 'If TO and FROM are mixed, fix them
i = FromPageNum
FromPageNum = ToPageNum
ToPageNum = i
End If
Set Rng = GetPageArea(FromPageNum)
For i = FromPageNum + 1 To ToPageNum
Set Rng = Union(Rng, GetPageArea(i))
Next
Debug.Print Rng.Address
Rng.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=ExportFullName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub
它使用 GetPageArea
函数 returns 所选页码的范围。
它需要 RndUp
函数才能工作,它只是将数字四舍五入。
Function GetPageArea(PageNum As Long, Optional Sh As Worksheet) As Range
'By Abdallah Ali El-Yaddak
Dim VBreakMax As Long, HBreakMax As Long, HBreak As Long, VBreak As Long
Dim c1 As Long, r1 As Long, c2 As Long, r2 As Long
If Sh Is Nothing Then Set Sh = ActiveSheet
With Sh
VBreakMax = .VPageBreaks.Count
HBreakMax = .HPageBreaks.Count
If PageNum > (VBreakMax + 1) * (HBreakMax + 1) Then
Set GetPageArea = Nothing 'Too high page number!
Else
If VBreakMax = 0 And HBreakMax = 0 Then
Set GetPageArea = .UsedRange 'Only one page
Else
VBreak = RndUp(PageNum / (HBreakMax + 1))
HBreak = PageNum - ((VBreak - 1) * (HBreakMax + 1))
If HBreak = 0 Then
HBreak = HBreakMax + 1
r2 = .UsedRange.Rows.Count
VBreak = VBreak - 1
Else
r2 = .HPageBreaks(HBreak).Location.Row - 1
End If
If VBreak > VBreakMax Then
c2 = .UsedRange.Columns.Count
Else
c2 = .VPageBreaks(VBreak).Location.Column - 1
End If
VBreak = VBreak - 1
HBreak = HBreak - 1
If VBreak = 0 Then
c1 = 1
Else
c1 = .VPageBreaks(VBreak).Location.Column
End If
If HBreak = 0 Then
r1 = 1
Else
r1 = .HPageBreaks(HBreak).Location.Row
End If
Set GetPageArea = .Range(.Cells(r1, c1), .Cells(r2, c2))
End If
End If
End With
End Function
Function RndUp(Amount As Double, Optional digits As Integer = 0) As Double
RndUp = Round((Amount + (5 / (10 ^ (digits + 1)))) * (10 ^ digits)) / (10 ^ digits)
End Function
要测试,你可以试试这个:
Sub Test()
PrintPages 3, 5, ThisWorkbook.Path & "\Test.pdf"
End Sub
我正在尝试添加一个按钮,该按钮提示用户输入页码 FROM 和 TO 并将该特定页面保存为 pdf。
这是我用来保存为 pdf 的代码。
'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
**From:=2, To:=2**, _
OpenAfterPublish:=True
'confirmation message with file info
MsgBox "PDF file has been saved."
End If
您可以尝试添加这些行:
Dim sheetNbr as integer
sheetNbr = InputBox ("Please input sheet number to export")
Set wsA = wbA.Sheets(sheetNbr)
现在在 wsA 下应该有对特定工作表编号的引用。
我的旧答案是不必要的。也许我误解了你的问题。 ExportAsFixedFormat 已经有 "To" & "From" 参数。所以,使用自定义代码来创建相同的东西是没有意义的。
新答案:
I am trying to add a button where the button prompts user to enter a page number FROM AND TO and save that specific page to pdf.
我想您所需要的只是一种请求用户输入的方法。在这种情况下,使用此代码:
Sub AskForPages()
Dim PageFromStr As String, PageToStr As String, ExportFullName As String
ExportFullName = ThisWorkbook.Path & "\Test.pdf"
PageFromStr = InputBox("Insert the number of the first page to export.")
'Validate the input to be a positive number.
If IsNumeric(PageFromStr) Then
If PageFromStr < 1 Then Beep: Exit Sub
Else
Beep
Exit Sub
End If
PageToStr = InputBox("Inster the number of the last page to export.")
'Validate the input to be a number greater than the "From".
If IsNumeric(PageToStr) Then
If PageToStr < PageFromStr Then Beep: Exit Sub
Else
Beep
Exit Sub
End If
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=ExportFullName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
From:=PageFromStr, To:=PageToStr, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub
旧答案:
您可以使用此子(传递要打印的页码(从和到))来执行此操作:
Sub PrintPages(FromPageNum As Long, ToPageNum As Long, ExportFullName as string)
Dim Rng As Range, i As Long
If FromPageNum > ToPageNum Then 'If TO and FROM are mixed, fix them
i = FromPageNum
FromPageNum = ToPageNum
ToPageNum = i
End If
Set Rng = GetPageArea(FromPageNum)
For i = FromPageNum + 1 To ToPageNum
Set Rng = Union(Rng, GetPageArea(i))
Next
Debug.Print Rng.Address
Rng.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=ExportFullName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub
它使用 GetPageArea
函数 returns 所选页码的范围。
它需要 RndUp
函数才能工作,它只是将数字四舍五入。
Function GetPageArea(PageNum As Long, Optional Sh As Worksheet) As Range
'By Abdallah Ali El-Yaddak
Dim VBreakMax As Long, HBreakMax As Long, HBreak As Long, VBreak As Long
Dim c1 As Long, r1 As Long, c2 As Long, r2 As Long
If Sh Is Nothing Then Set Sh = ActiveSheet
With Sh
VBreakMax = .VPageBreaks.Count
HBreakMax = .HPageBreaks.Count
If PageNum > (VBreakMax + 1) * (HBreakMax + 1) Then
Set GetPageArea = Nothing 'Too high page number!
Else
If VBreakMax = 0 And HBreakMax = 0 Then
Set GetPageArea = .UsedRange 'Only one page
Else
VBreak = RndUp(PageNum / (HBreakMax + 1))
HBreak = PageNum - ((VBreak - 1) * (HBreakMax + 1))
If HBreak = 0 Then
HBreak = HBreakMax + 1
r2 = .UsedRange.Rows.Count
VBreak = VBreak - 1
Else
r2 = .HPageBreaks(HBreak).Location.Row - 1
End If
If VBreak > VBreakMax Then
c2 = .UsedRange.Columns.Count
Else
c2 = .VPageBreaks(VBreak).Location.Column - 1
End If
VBreak = VBreak - 1
HBreak = HBreak - 1
If VBreak = 0 Then
c1 = 1
Else
c1 = .VPageBreaks(VBreak).Location.Column
End If
If HBreak = 0 Then
r1 = 1
Else
r1 = .HPageBreaks(HBreak).Location.Row
End If
Set GetPageArea = .Range(.Cells(r1, c1), .Cells(r2, c2))
End If
End If
End With
End Function
Function RndUp(Amount As Double, Optional digits As Integer = 0) As Double
RndUp = Round((Amount + (5 / (10 ^ (digits + 1)))) * (10 ^ digits)) / (10 ^ digits)
End Function
要测试,你可以试试这个:
Sub Test()
PrintPages 3, 5, ThisWorkbook.Path & "\Test.pdf"
End Sub