Thanks for taking the time to read my question.

Is it possible to add custom animation to pictures in PPT?

I have about 300 pics that I want to put into a PPT presentation. Here is my
code so far. All I need to add is the Custom Animation settings to this but
I can't figure out how.

I've tried recording it as a macro but it doesn't record.

Thanks,

Brad

CODE:
Sub AddPics()
Dim FileScript, FolderPath, FileSet, FileSelection
Dim x As Integer
Dim ThePic As String
x = 2

Set FileScript = CreateObject("Scripting.FileSystemObject")
Set FolderPath = FileScript.GetFolder("D:\Pictures\Florence Birmingham\")
'Path here
Set FileSet = FolderPath.Files




For Each FileSelection In FileSet

ThePic = "D:\Pictures\Florence Birmingham\" & FileSelection.Name

If Right(ThePic, 3) <> "avi" Then


ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=ThePic,
LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=0, Top:=0).Select
ActiveWindow.Selection.ShapeRange.Top = 0
ActiveWindow.Selection.ShapeRange.Left = 0
pHeight = ActiveWindow.Selection.ShapeRange.Height
pWidth = ActiveWindow.Selection.ShapeRange.Width
If pHeight < pWidth Then 'its wider
ActiveWindow.Selection.ShapeRange.Width = 720
Else 'its taller
ActiveWindow.Selection.ShapeRange.Height = 540
End If


ActiveWindow.View.GotoSlide
Index:=ActivePresentation.Slides.Add(Index:=x,
Layout:=ppLayoutBlank).SlideIndex

x = x + 1

End If


Next

End Sub

RE: Custom Animation and VBA by john

john
Fri Aug 15 12:32:01 CDT 2008

The code depends on the version you have. Animation changed greatly with ppt
XP. If you have at least XP this page from Shyam should help
http://skp.mvps.org/pptxp012.htm#interactive
--

Amazing PPT Hints, Tips and Tutorials

http://www.pptalchemy.co.uk/powerpoint_hints_and_tips_tutorials.html

email john AT technologytrish.co.uk


"Brad" wrote:

> Thanks for taking the time to read my question.
>
> Is it possible to add custom animation to pictures in PPT?
>
> I have about 300 pics that I want to put into a PPT presentation. Here is my
> code so far. All I need to add is the Custom Animation settings to this but
> I can't figure out how.
>
> I've tried recording it as a macro but it doesn't record.
>
> Thanks,
>
> Brad
>
> CODE:
> Sub AddPics()
> Dim FileScript, FolderPath, FileSet, FileSelection
> Dim x As Integer
> Dim ThePic As String
> x = 2
>
> Set FileScript = CreateObject("Scripting.FileSystemObject")
> Set FolderPath = FileScript.GetFolder("D:\Pictures\Florence Birmingham\")
> 'Path here
> Set FileSet = FolderPath.Files
>
>
>
>
> For Each FileSelection In FileSet
>
> ThePic = "D:\Pictures\Florence Birmingham\" & FileSelection.Name
>
> If Right(ThePic, 3) <> "avi" Then
>
>
> ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=ThePic,
> LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=0, Top:=0).Select
> ActiveWindow.Selection.ShapeRange.Top = 0
> ActiveWindow.Selection.ShapeRange.Left = 0
> pHeight = ActiveWindow.Selection.ShapeRange.Height
> pWidth = ActiveWindow.Selection.ShapeRange.Width
> If pHeight < pWidth Then 'its wider
> ActiveWindow.Selection.ShapeRange.Width = 720
> Else 'its taller
> ActiveWindow.Selection.ShapeRange.Height = 540
> End If
>
>
> ActiveWindow.View.GotoSlide
> Index:=ActivePresentation.Slides.Add(Index:=x,
> Layout:=ppLayoutBlank).SlideIndex
>
> x = x + 1
>
> End If
>
>
> Next
>
> End Sub
>