OK. I think I have solved their problem. Deleting all the pictures
(that aren't in placeholders) was easy:
Sub DeletePix()
Dim sld As Slide
Dim shp As Shape
For Each sld In ActivePresentation.Slides
If sld.SlideIndex <> 1 Then
For Each shp In sld.Shapes
If shp.Type = msoPicture Then
shp.Delete
End If
Next shp
End If
Next sld
End Sub
The tough part was figuring out what they wanted to do with adding the
pictures. They have 78 pens for dogs, 37 pens for cats, and 4 pens for
rabbits. They take pictures of each pen with a digital camera every day
(whether or not an animal is actually in the pen). The pictures are
generally numbered consecutively (from 1 to 78 for the dogs) with the
date prefixed to the number in 3-digit format. However, when a picture
doesn't come out, a picture might be missing in the middle; for example,
they might be numbered from 1 to 79 with 32 missing. Furthermore, the
dog pictures might start at number 1, while the cat pictures might start
at number 89, and the rabbit pictures might start at number 143, so they
need the code to ask where to start. The only thing the code doesn't do
(which wouldn't be that hard, but they didn't ask) is to ask which animal
or how many pictures there are, so they have to change the number in the
code for each animal. I assume they'll make their own procedures for
each number (AddDogs, AddCats, AddRabbits), but that is up to them. Here
is the code that does all this (watch out for line breaks caused by
wrapping):
Sub AddPixAsk()
Dim sld As Slide
Dim slideNumber As Long
Dim picNumber As Long
Dim picNumberTxt As String
Dim pixFile As String
Dim theDate As String
'Change 78 to the number of pictures (78 for dogs, 37 for cats, 4 for
rabbits)
Const numberOfPix As Long = 78
theDate = InputBox("What is today's date (use the form MMDDYY)?")
picNumberTxt = InputBox("What is the number of the first picture?")
On Error GoTo BadNumber
picNumber = CLng(picNumberTxt)
On Error GoTo 0
If picNumber < 0 Or picNumber > 999 Then
picNumber = 0
MsgBox "That wasn't a valid number. We'll just start from picture
#1"
Else
picNumber = picNumber - 1 'We add one to it at the beginning of
the loop
End If
For slideNumber = 2 To numberOfPix + 1
SetUpFileName:
picNumber = picNumber + 1
If picNumber < 10 Then
pixFile = theDate & " 00" & picNumber & ".jpg"
ElseIf picNumber < 100 Then
pixFile = theDate & " 0" & picNumber & ".jpg"
Else
pixFile = theDate & " " & picNumber & ".jpg"
End If
On Error GoTo MissingPicture
ActivePresentation.Slides(slideNumber).Shapes.AddPicture _
FileName:=pixFile, LinkToFile:=msoFalse, SaveWithDocument:
=msoTrue, _
Left:=220, Top:=220
On Error GoTo 0
Next slideNumber
Exit Sub
MissingPicture:
If picNumber < 999 Then
Resume SetUpFileName
Else
MsgBox "You seem to have run out of pictures."
End If
Exit Sub
BadNumber:
picNumber = -1
Resume Next
End Sub
--
David M. Marcovitz
Director of Graduate Programs in Educational Technology
Loyola College in Maryland
Author of _Powerful PowerPoint for Educators_
http://www.loyola.edu/education/PowerfulPowerPoint/