如何将特定页面从单个 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