How to export two PowerPoint slides to PDF file? - vba

Question

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")

Answer 1

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