1
votes

In this site, I found code that it prints the last slide as PDF.

Sub PDFtesti()
    
timestamp = Now()
Dim PR As PrintRange
Dim lngLast As Long
Dim lngFirst As Long
Dim savePath As String
Dim PrintPDF As Integer
Dim name As String

name = ActivePresentation.Slides(2).Shapes("TextBox1").OLEFormat.object.Text

savePath = "C:\Powerpoint\" & Format(timestamp, "yyyymmdd-hhnn") & " - " & name & ".pdf"

lngLast = ActivePresentation.Slides.Count

With ActivePresentation.PrintOptions
    .Ranges.ClearAll
Set PR = .Ranges.Add(lngLong, lngLong)
End With

ActivePresentation.ExportAsFixedFormat _
Path:=savePath, _
FixedFormatType:=ppFixedFormatTypePDF, _
PrintRange:=PR, _
Intent:=ppFixedFormatIntentScreen, _
FrameSlides:=msoTrue, _
RangeType:=ppPrintSlideRange 

End Sub

I would like print two slides: slide number 2 and last page.

I tried

Set PR = .Ranges.Add(lngLong, lngLong)
Set PR = .Ranges.Add(2, 2)

and

Set PR = .Ranges.Add(Array("lngLong, lngLong" & "2,2")
1

1 Answers

0
votes

Updated solution. In order to make printing specific slides more comfortable, I decided to put them into one variable (slidesToPrint). All slides not put into this variable are hidden just before printing (so they are not printed). After printing the hide order is restored to the original. So, slides which must be printed, bust be listed in this line:
slidesToPrint = Array(2, lngLast)

Full code:

Sub PDFtesti()

Dim timestamp As Date
Dim PR As PrintRanges
Dim lngLast As Long
Dim lngFirst As Long
Dim savePath As String
Dim PrintPDF As Integer
Dim name As String
Dim originalHides() As Long
Dim slidesToPrint() As Variant
Dim i As Variant

timestamp = Now()
With ActivePresentation
    name = .Slides(2).Shapes("TextBox1").OLEFormat.Object.Text
    savePath = "C:\Powerpoint\" & Format(timestamp, "yyyymmdd-hhnn") & " - " & name & ".pdf"
    lngLast = .Slides.Count
    .PrintOptions.Ranges.ClearAll
    
    ' Slides to print are put here (inside parentheses)
    slidesToPrint = Array(2, lngLast)
    
    ReDim originalHides(1 To lngLast)
    For i = 1 To lngLast
      originalHides(i) = .Slides(i).SlideShowTransition.Hidden
      .Slides(i).SlideShowTransition.Hidden = -1
    Next
    For Each i In slidesToPrint()
      .Slides(i).SlideShowTransition.Hidden = 0
    Next
    .ExportAsFixedFormat _
        Path:=savePath, _
        FixedFormatType:=ppFixedFormatTypePDF, _
        Intent:=ppFixedFormatIntentScreen, _
        FrameSlides:=msoTrue
    For i = 1 To lngLast
      .Slides(i).SlideShowTransition.Hidden = originalHides(i)
    Next
End With

End Sub

In your code you use PR As PrintRange. But since you want two pages, the second and the last, you will need two ranges, which is not of type PrintRange, but instead, PrintRanges. In this case you would do:

.Ranges.Add(2, 2)
.Ranges.Add(lngLast, lngLast)

But this would not work, because the function ExportAsFixedFormat only accepts PrintRange, but not PrintRanges. One option would be printing both slides to separate files first using PrintRanges(1) i.e. (2, 2) and next using PrintRanges(2) i.e. (lngLast, lngLast). But this is not really what you want.

The solution. It uses PR(1) (PR is of type PrintRanges, while PR(1) is PrintRange). PR(1) is the range corresponding to the last two slides. The trick is that just before printing you move the second slide to the position lngLast - 1 (one before last) and after printing you return it to the correct place.

This moves the second slide to one before last position:
.Slides(2).MoveTo lngLast - 1
This returns it to the original position:
.Slides(lngLast - 1).MoveTo 2

Full code:

Sub PDFtesti()

Dim timestamp As Date
Dim PR As PrintRanges
Dim lngLast As Long
Dim lngFirst As Long
Dim savePath As String
Dim PrintPDF As Integer
Dim name As String

timestamp = Now()
With ActivePresentation
    name = .Slides(2).Shapes("TextBox1").OLEFormat.Object.Text
    savePath = "C:\Powerpoint\" & Format(timestamp, "yyyymmdd-hhnn") & " - " & name & ".pdf"
    lngLast = .Slides.Count
    Set PR = .PrintOptions.Ranges
    PR.ClearAll
    PR.Add lngLast - 1, lngLast
    
    .Slides(2).MoveTo lngLast - 1
    .ExportAsFixedFormat _
        Path:=savePath, _
        FixedFormatType:=ppFixedFormatTypePDF, _
        PrintRange:=PR(1), _
        Intent:=ppFixedFormatIntentScreen, _
        FrameSlides:=msoTrue, _
        RangeType:=ppPrintSlideRange
    .Slides(lngLast - 1).MoveTo 2
End With

End Sub