G
Geoff Cox
Hello,
The macro below has been working but suddenly nothing happens when I
run it!? It has been inserting an action button in the last slide of a
series of ppt files.
Any ideas please? Any obvious syntax error? Oddly the VBA editor debug
comes up with no errors.
Geoff
Sub ForEachPresentation()
' Run a macro of your choosing on each presentation in a folder
Dim rayFileList() As String
Dim FolderPath As String
Dim FileSpec
Dim strTemp As String
Dim x As Long
' EDIT THESE to suit your situation
FolderPath = "c:\fred\activities\" ' Note: MUST end in \
FileSpec = "*.ppt"
' END OF EDITS
' Fill the array with files that meet the spec above
ReDim rayFileList(1 To 1) As String
strTemp = Dir$(FolderPath & FileSpec)
While strTemp <> ""
rayFileList(UBound(rayFileList)) = FolderPath & strTemp
ReDim Preserve rayFileList(1 To UBound(rayFileList) + 1) As
String
strTemp = Dir
Wend
' array has one blank element at end - don't process it
' don't do anything if there's less than one element
If UBound(rayFileList) > 1 Then
For x = 1 To UBound(rayFileList) - 1
Call MyMacro(rayFileList(x))
Next x
End If
End Sub
Sub MyMacro(strMyFile As String)
' this gets called once for each file that meets the spec you enter in
ForEachPresentation
' strMyFile is set to the file name each time
' Probably at a minimum, you'd want to:
Dim oPresentation As Presentation
Set oPresentation = Presentations.Open(strMyFile)
With oPresentation
With ActivePresentation.Slides(ActivePresentation.Slides.Count)_
..Shapes.AddShape(msoShapeActionButtonForwardorNext, 189.88, _
389.12,153.12, 39.62)
With .ActionSettings(ppMouseClick)
.Hyperlink.Address = "C:\fred\menu.ppt"
.SoundEffect.Type = ppSoundNone
.AnimateAction = msoTrue
End With
' delete the next five lines if you don't need to add a mouseover
With .ActionSettings(ppMouseOver)
.Action = ppActionNone
.SoundEffect.Type = ppSoundNone
.AnimateAction = msoFalse
End With
End With
oPresentation.Save
oPresentation.Close
End With
End Sub
The macro below has been working but suddenly nothing happens when I
run it!? It has been inserting an action button in the last slide of a
series of ppt files.
Any ideas please? Any obvious syntax error? Oddly the VBA editor debug
comes up with no errors.
Geoff
Sub ForEachPresentation()
' Run a macro of your choosing on each presentation in a folder
Dim rayFileList() As String
Dim FolderPath As String
Dim FileSpec
Dim strTemp As String
Dim x As Long
' EDIT THESE to suit your situation
FolderPath = "c:\fred\activities\" ' Note: MUST end in \
FileSpec = "*.ppt"
' END OF EDITS
' Fill the array with files that meet the spec above
ReDim rayFileList(1 To 1) As String
strTemp = Dir$(FolderPath & FileSpec)
While strTemp <> ""
rayFileList(UBound(rayFileList)) = FolderPath & strTemp
ReDim Preserve rayFileList(1 To UBound(rayFileList) + 1) As
String
strTemp = Dir
Wend
' array has one blank element at end - don't process it
' don't do anything if there's less than one element
If UBound(rayFileList) > 1 Then
For x = 1 To UBound(rayFileList) - 1
Call MyMacro(rayFileList(x))
Next x
End If
End Sub
Sub MyMacro(strMyFile As String)
' this gets called once for each file that meets the spec you enter in
ForEachPresentation
' strMyFile is set to the file name each time
' Probably at a minimum, you'd want to:
Dim oPresentation As Presentation
Set oPresentation = Presentations.Open(strMyFile)
With oPresentation
With ActivePresentation.Slides(ActivePresentation.Slides.Count)_
..Shapes.AddShape(msoShapeActionButtonForwardorNext, 189.88, _
389.12,153.12, 39.62)
With .ActionSettings(ppMouseClick)
.Hyperlink.Address = "C:\fred\menu.ppt"
.SoundEffect.Type = ppSoundNone
.AnimateAction = msoTrue
End With
' delete the next five lines if you don't need to add a mouseover
With .ActionSettings(ppMouseOver)
.Action = ppActionNone
.SoundEffect.Type = ppSoundNone
.AnimateAction = msoFalse
End With
End With
oPresentation.Save
oPresentation.Close
End With
End Sub