Question

我正在尝试添加一个按钮，该按钮会提示用户输入页码并将该特定页面保存为pdf。

这是我用来另存为pdf的代码。但这会将整个工作表保存为pdf。

Option Explicit

Sub SaveAsPDF()

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
Dim Filename As String

On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")

Filename = ActiveWorkbook.Name                          '<------- added this code
If InStr(Filename, ".") > 0 Then
   Filename = Left(Filename, InStr(Filename, ".") - 1)
End If

'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(Filename, " ", "_")                    '<--- changed wbA to Filename
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & ".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 File Name 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:=True
    'confirmation message with file info
    MsgBox "PDF file has been saved."
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler

End Sub

我需要进行哪些更改才能使用户将特定页面保存为pdf。顺便说一下，我将所有这些代码保存在personal.xlb文件中。

如果有人帮助您，我将不胜感激。谢谢。

Answer 1

我以前的答案是不必要的。也许我误解了你的问题。 ExportAsFixedFormat已经具有“ To”和“ From”自变量。因此，使用自定义代码创建相同的东西是没有意义的。

新答案：

我正在尝试添加一个按钮，该按钮会提示用户输入页码从和到，并将该特定页面保存为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来返回所选页码的范围。

它需要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

Answer 2

您可以尝试添加以下行：

Dim sheetNbr as integer
sheetNbr = InputBox ("Please input sheet number to export")

Set wsA = wbA.Sheets(sheetNbr)

现在在wsA下应该有对特定工作表编号的引用。

如何将Excel特定页面保存为pdf？

2 个答案: