PPT2000: Sample Code to Copy Slides to Another Presentation
ID: Q222780
|
The information in this article applies to:
-
Microsoft PowerPoint 2000
SUMMARY
This article contains a sample Microsoft Visual Basic for Applications
macro (Sub procedure) that copies all slides, as PowerPoint objects, from
your active presentation to another presentation. If you have one
presentation open, the macro creates the slides, and adds them to the new
presentation. If you have two presentations open, the macro appends the
slides to the end of the second presentation.
MORE INFORMATION
Microsoft provides programming examples for illustration only, without
warranty either expressed or implied, including, but not limited to, the
implied warranties of merchantability and/or fitness for a particular
purpose. This article assumes that you are familiar with the programming
language being demonstrated and the tools used to create and debug
procedures. Microsoft Support professionals can help explain the functionality
of a particular procedure, but they will not modify these examples to
provide added functionality or construct procedures to meet your specific
needs. If you have limited programming experience, you may want to contact
the Microsoft fee-based consulting line at (800) 936-5200. For more
information about the support options available from Microsoft, please see
the following page on the World Wide Web:
http://www.microsoft.com/support/supportnet/overview/overview.asp
NOTE: The following macro examples only work from within the PowerPoint application. Visual Basic for Applications macros are not supported by the Microsoft PowerPoint Viewer. For additional information, please see the following article in the Microsoft Knowledge Base:
Q230746 PPT: Viewer: Presentation Macros Don't Run
Sample Visual Basic Procedure
Sub SlideCopy()
' Variable declarations.
Dim SourceView, answer As Integer
Dim SourceSlides, NumPres, x As Long
' Count the open presentations.
NumPres = Presentations.Count
' Check to see whether more than one presentation is open.
If NumPres = 0 Then
' If no presentations are open, stop the macro.
MsgBox "You must have at least one presentation open", _
vbCritical + vbOKOnly, "No Presentations Open"
End
End If
' If more than two presentations are open, quit the macro.
If NumPres > 2 Then
MsgBox "To many open presentations. Only two presentations" _
& " may be open." & Chr(13) & "The active presentation is " _
& "the source and other presentation is the destination.", _
vbOKOnly + vbCritical, "To Many Open Presentations"
End
End If
' Stores the current view of the source presentation.
SourceView = ActiveWindow.ViewType
' Count the number of slides in source presentation.
SourceSlides = ActivePresentation.Slides.Count
' See whether only one presentation is open.
If NumPres = 1 Then
answer = MsgBox("Only one presentation is open. " & _
"This presentation will be used as the source. " & _
Chr(13) & "Press YES to create a new presentation as " _
& "the destination.", vbYesNo + vbQuestion, "Only One " _
& "Presentation Open")
' If no selected in the message box, quit the macro.
If answer = vbNo Then
End
End If
' Create a new presentation for the designation.
Presentations.Add
' Set up the slide size to be the same as the source.
With ActivePresentation.PageSetup
.SlideHeight = Presentations(1).PageSetup.SlideHeight
.SlideWidth = Presentations(1).PageSetup.SlideWidth
End With
' Switch the destination presentation to slide view.
If ActiveWindow.ViewType <> ppViewSlide Then
ActiveWindow.ViewType = ppViewSlide
End If
' Switch to the source presentation.
Presentations(1).Windows(1).Activate
End If
' Change the view to slide sorter if not there already.
If ActiveWindow.ViewType <> ppViewSlideSorter Then
ActiveWindow.ViewType = ppViewSlideSorter
End If
' Loop through all the slides and copy them to destination one by
' one.
For x = 1 To SourceSlides
' Select the first slide in the presentation and copy it.
ActivePresentation.Slides.Range(Array(x)).Select
ActiveWindow.Selection.Copy
' Switch to destination presentation.
Presentations(2).Windows(1).Activate
' Create a new slide.
ActivePresentation.Slides.Add _
ActivePresentation.Slides.Count + 1, ppLayoutBlank
' Make sure the new presentation is slide view.
If ActiveWindow.ViewType <> ppViewSlide Then
ActiveWindow.ViewType = ppViewSlide
End If
' Switch to the proper slide.
ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Count
' Paste the slide.
ActiveWindow.View.Paste
' Adjust the size of the pasted object.
With ActiveWindow.Selection.ShapeRange
.Left = 0
.Top = 0
.Width = ActivePresentation.PageSetup.SlideWidth
.Height = ActivePresentation.PageSetup.SlideHeight
End With
' Unselect the object.
ActiveWindow.Selection.Unselect
' Switch to source.
Presentations(1).Windows(1).Activate
Next x
' Restore the current view to source.
ActiveWindow.ViewType = SourceView
End Sub
REFERENCES
For more information about using the sample code in this article, please
see the following article in the Microsoft Knowledge Base:
Q212536
OFF2000: How to Run Sample Code from Knowledge Base Articles
Additional query words:
9.00 ppt9 vba vbe ppt2k powerpt vba2k ppt9.0 ppt2000 program programming
Keywords : kbcode kbmacro kbprg kbdta kbdtacode kbpptvba
Version : WINDOWS:2000
Platform : WINDOWS
Issue type : kbhowto