Jackie, Here's some code I wrote modifying some of Shyam's other code
to call the API to do just this.
It's on google.
Here's a bit of code that is based on Shyam's example of the Sleep api
call. It opens the Insert Picture from File dialogue and hangs out
till a variable is set to False based on the count of shapes on a
slide since if it didn't wait for the user to insert a picture the
code would be finished running and not insert the selected picture.
Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
''' Comments: This routine uses an API call to Sleep while the
dialog is open.
''' Otherwise the code would continue running before the
user got to insert the picture.
''' Also captures the Cancel button by counting objects
after the dialog closes.
''' Also runs a counter after the dialog closes to capture
the Cancel click which cannot be captured normally.
''' Date Developer Action
''' 2/10/02 Brian Reilly Created
Sub Insert_Picture_on_Title_Dialog()
Dim strViewType As String
Dim lShapeCount As Long
Dim i As Integer, j As Integer
Dim iTimeCounter As Integer
On Error GoTo errorhandler
strViewType = ActiveWindow.ViewType
'Check for TitleMaster first
If ActivePresentation.HasTitleMaster = False Then
MsgBox "This presentation does not have a TitleMaster. Exiting
.. . ."
Exit Sub
Else
'Continue
End If
lShapeCount = ActivePresentation.TitleMaster.Shapes.Count
'Just in the eventuality that you click the start button twice
'isRunning stores the current state of the macro
'TRUE = Running; FALSE = Idle
Static isRunning As Boolean
If isRunning = True Then
End
Else
isRunning = True
With ActivePresentation
ActiveWindow.ViewType = ppViewTitleMaster
With .TitleMaster
For i = 1 To .Shapes.Count
For j = 1 To .Shapes(i).Tags.Count
If .Shapes(i).Tags.Name(j) =
"TITLEMASTERPICTURE" Then
.Shapes(i).Delete
'Now reset the shape counter
lShapeCount =
ActivePresentation.TitleMaster.Shapes.Count
End If
Next j
Next i
End With
End With
CommandBars("Insert").Controls("Picture").Controls("From
File...").Execute
Do While (ActivePresentation.TitleMaster.Shapes.Count =
lShapeCount)
' Suspend program execution for 1/5 second (500
milliseconds)
iTimeCounter = iTimeCounter + 1
Sleep 500
If iTimeCounter > 2 Then
ActiveWindow.ViewType = strViewType
'The user canceled the dialog
Exit Do
ElseIf ActivePresentation.TitleMaster.Shapes.Count <>
lShapeCount Then
Exit Do
Else
End If '
' Very crucial else the display won't refresh itself
DoEvents
Loop
isRunning = False
'Now capture the Cancel button click and exit
If ActivePresentation.TitleMaster.Shapes.Count = lShapeCount
Then
Exit Sub
Else
'continue
End If
With ActivePresentation.TitleMaster.Shapes(lShapeCount + 1)
.Tags.Add "TitleMasterPicture", "Present"
'Next line out in case heights of pictures vary
'.LockAspectRatio = false
.Top = 0
.Left = 0
'Next line out in case heights of pictures vary
'.Height = 420
.Width = 720.66
.LockAspectRatio = True
End With
ActiveWindow.ViewType = strViewType
End
End If
Exit Sub
errorhandler:
MsgBox Error
End Sub
Brian Reilly, PowerPoint MVP
Brian Reilly, PowerPoint MVP
