Article ID: 171571
Article Last Modified on 10/11/2006
' These are user-defined data types; you need to place them in the
' Declarations section at the beginning of the module that contains
' the macro.
Type PageBoxSize
l As Long
h As Long
t As Long
w As Long
End Type
Type SlideInfo
ID As Long
IsVisible As Boolean
End Type
Sub PrintCustomShow()
' Change this number to specify your starting slide number.
Const lStartNum as Long = 1
' Ask the user which custom show they want to print.
Dim strShowToPrint As String, strPrompt As String
Dim strTitle As String, strDefault As String
' See if any custom shows are defined.
If ActivePresentation.SlideShowSettings.NamedSlideShows.Count _
< 1 Then
' No custom shows are defined.
' Set up the string for the message box.
strPrompt = "You have no custom shows defined!"
' Display the message box and stop the macro.
MsgBox strPrompt, vbCritical
End
End If
' Find the page number placeholder; if found, pick up the style.
Dim rect As PageBoxSize
Dim oPlaceHolder As Shape
Dim bFound As Boolean: bFound = False
For Each oPlaceHolder In _
ActivePresentation.SlideMaster.Shapes.Placeholders
' Look for the slide number placeholder.
If oPlaceHolder.PlaceholderFormat.Type = _
ppPlaceholderSlideNumber Then
' Get the position of the page number placeholder.
rect.l = oPlaceHolder.Left
rect.t = oPlaceHolder.Top
rect.w = oPlaceHolder.Width
rect.h = oPlaceHolder.Height
' Get the formatting of the slide number placeholder.
oPlaceHolder.PickUp
' Found the slide number placeholder, so set the
' bFound boolean to True.
bFound = True
Exit For
End If
Next oPlaceHolder
' See if a slide number placeholder was found.
' If not found, exit the macro.
If bFound = False Then
' Unable to find slide number placeholder.
MsgBox "Your master slide does not contain a slide number " _
& "placeholder. Add a " & vbCrLf & "slide number placeholder" _
& " and run the macro again.", vbCritical
End
End If
' Set up the string for the input box.
strPrompt = "Type the name of the custom show you want to print." _
& vbCrLf & vbCrLf & "Custom Show List" & vbCrLf _
& "==============" & vbCrLf
' This is the title of the input box.
strTitle = "Print Custom Show"
' Use the first defined show as the default.
strDefault = _
ActivePresentation.SlideShowSettings.NamedSlideShows(1).Name
' Obtain the names of all custom slide shows.
Dim oCustomShow As NamedSlideShow
For Each oCustomShow In _
ActivePresentation.SlideShowSettings.NamedSlideShows
strPrompt = strPrompt & oCustomShow.Name & vbCrLf
Next oCustomShow
Dim bMatch As Boolean: bMatch = False
' Loop until a named show is matched or user clicks Cancel.
While (bMatch = False)
' Display the input box that prompts the user to type in
' the slide show they want to print.
strShowToPrint = InputBox(strPrompt, strTitle, strDefault)
' See if user clicked Cancel.
If strShowToPrint = "" Then
End
End If
' Make sure the return value of the input box is a valid name.
For Each oCustomShow In _
ActivePresentation.SlideShowSettings.NamedSlideShows
' See if the show is in the NamedSlideShows collection.
If strShowToPrint = oCustomShow.Name Then
bMatch = True
' Leave the For loop, because a match was found.
Exit For
End If
' No match was found.
bMatch = False
Next oCustomShow
Wend
' Get the array of slide IDs used in the show.
Dim vShowSlideIDs As Variant
With ActivePresentation.SlideShowSettings
vShowSlideIDs = .NamedSlideShows(strShowToPrint).SlideIDs
End With
' Loop through the slides and turn off page numbering.
Dim vSlideID As Variant
Dim oSlide As Slide
Dim Info() As SlideInfo
' Make room in the array.
ReDim Preserve Info(UBound(vShowSlideIDs) - 1)
' Save the current background printing setting and
' then turn background printing off.
Dim bBackgroundPrinting As Boolean
bBackgroundPrinting = _
ActivePresentation.PrintOptions.PrintInBackground
ActivePresentation.PrintOptions.PrintInBackground = msoFalse
' Loop through every slide in the custom show.
Dim x As Long: x = 0
For Each vSlideID In vShowSlideIDs
' The first element in the array is zero and not used.
If vSlideID <> 0 Then
' Add slide ID to the array.
Info(x).ID = CLng(vSlideID)
' Get a reference to the slide.
Set oSlide = ActivePresentation.Slides.FindBySlideID(vSlideID)
' Store the visible state of the page number.
Info(x).IsVisible = oSlide.HeadersFooters.SlideNumber.Visible
' Turn off page numbering, if needed.
If Info(x).IsVisible = True Then
oSlide.HeadersFooters.SlideNumber.Visible = msoFalse
End If
' Create a text box and add a temporary page number in it.
Dim oShape As Shape
Set oShape = _
oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, _
rect.l, rect.t, _
rect.w, rect.h)
' Apply the formatting used for the slide number placeholder to
' the text box you just created.
oShape.Apply
' Add the page number text to the text box.
oShape.TextFrame.TextRange = CStr(x + lStartNum)
' Print the slide. NOTE: You must turn background printing off.
ActivePresentation.PrintOut oSlide.SlideNumber, _
oSlide.SlideNumber
' Increment the array element positon.
x = x + 1
' Delete the temporary slide number shape.
oShape.Delete
End If
Next vSlideID
' Restore the slide information.
For x = 0 To UBound(Info)
' Get a reference to the slide.
Set oSlide = ActivePresentation.Slides.FindBySlideID(Info(x).ID)
oSlide.HeadersFooters.SlideNumber.Visible = Info(x).IsVisible
Next x
' Restore the background printing setting.
ActivePresentation.PrintOptions.PrintInBackground = _
bBackgroundPrinting
End Sub
176476 OFF: Office Assistant Not Answering Visual Basic Questions
163435 VBA: Programming Resources for Visual Basic for Applications
Additional query words: 8.00 ppt8 vba vbe macppt mac_ppt ppt98 powerpt
Keywords: kbcode kbdtacode kbhowto kbmacro kbprogramming KB171571