Как экспортировать конкретную страницу из одного листа в PDF? - PullRequest
Новая
       44

Как экспортировать конкретную страницу из одного листа в PDF?

0 голосов
/ 02 июня 2019

Я пытаюсь добавить кнопку, где кнопка предлагает пользователю ввести номер страницы ОТ И К и сохранить эту конкретную страницу в формате 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

Ответы [ 2 ]

1 голос
/ 03 июня 2019

Мой старый ответ не нужен.Может быть, я неправильно понял ваш вопрос.У ExportAsFixedFormat уже есть аргументы «Кому» и «От».Поэтому нет смысла использовать собственный код для создания того же самого.

Новый ответ:

Я пытаюсь добавитькнопка, в которой кнопка предлагает пользователю ввести номер страницы ОТ И К и сохранить эту конкретную страницу в формате 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

Старый ответ:

Вы можете использовать этот подпункт (передача номера страницы для печати (с& To)) для этого: 

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
0 голосов
/ 02 июня 2019

Вы можете попробовать добавить следующие строки: 

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

Set wsA = wbA.Sheets(sheetNbr)

Теперь под wsA должна быть ссылка на конкретный номер листа.

...