Article ID: 162498
Article Last Modified on 10/11/2006
Sub AddMedia()
' Used for error trapping.
On Error Resume Next
Err.Clear
' The slide number to change.
Const longSlideNumber As Long = 1
' Holds the path to the media object.
Const stringPath = "c:\temp\"
' Holds the name of the file.
Const stringName = "test.avi"
' Used to store an object reference to a shape.
Dim shapeAVI As Shape
Dim sswShow As SlideShowWindow
' Variables to store the slide height and width.
Dim longSlideHeight As Long
Dim longSlideWidth As Long
' Assign sswShow to the current show.
Set sswShow = ActivePresentation.SlideShowWindow
' Check if they are in slide show.
If Err.Number <> 0 Then
MsgBox "This macro must be run from within a slide show. " _
& "Modify the Action Settings of an object to run this macro." _
, vbCritical, "Assign Macro to a Button"
End
End If
' Create the object.
With ActivePresentation.Slides(longSlideNumber).Shapes
Set shapeAVI = .AddMediaObject(stringPath & stringName, 0, 0)
End With
' Set the play settings for the movie.
With shapeAVI.AnimationSettings
.PlaySettings.PlayOnEntry = msoTrue
.AdvanceMode = ppAdvanceOnTime
.AdvanceTime = 0
End With
' Get the slide height and width.
longSlideHeight = ActivePresentation.PageSetup.SlideHeight
longSlideWidth = ActivePresentation.PageSetup.SlideWidth
' Center the media object horizontally.
If shapeAVI.Width <= longSlideWidth Then
shapeAVI.Left = ((longSlideWidth - shapeAVI.Width) \ 2)
End If
' Center the media object vertically.
If shapeAVI.Height <= longSlideHeight Then
shapeAVI.Top = ((longSlideHeight - shapeAVI.Height) \ 2)
End If
' Refresh the slide to get the animation to play.
sswShow.View.GotoSlide (longSlideNumber)
End Sub
176476 OFF: Office Assistant Not Answering Visual Basic Questions
163435 VBA: Programming Resources for Visual Basic for Applications
Additional query words: 97 8.00 kbmacro kbpptvba ppt8 vba vbe powerpnt
Keywords: kbhowto kbmacro kbprogramming kbdtacode kbcode KB162498