PDA

View Full Version : Adding a Set of Images to a Template.



RichardG118
08-30-2012, 07:40 AM
Hi,

I've am trying to create a template that will allow the batch import of images from a single folder. The folder however will be different each time and so hard coding the directory is too static.

I have been using the BATCH insert code and have it working perfectly. I can not however work out how to have the directory in which the images sit as a user definable path.

Sub ImportImagesforPhotoPack()
Dim strTemp As String
Dim strPath As String
Dim strFileSpec As String
Dim oSld As Slide
Dim oPic As Shape

' Edit these to suit:
strPath = "C:\Documents and Settings\richardg\My Documents\AutoPPT\Images\"
strFileSpec = "*.jpg"
strTemp = Dir(strPath & strFileSpec)
Do While strTemp <> ""
Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)
Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strTemp, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=60, _
Top:=32, _
Width:=1037, _
Height:=742)

' Get the next file that meets the spec and go round again
strTemp = Dir

Loop
End Sub

I hope this has'nt been asked too many times, thank you for you help.
Richard.:banghead:

John Wilson
08-30-2012, 10:34 AM
Try this:

Sub ImportImagesforPhotoPack()
Dim strTemp As String
Dim strPath As String
Dim strFileSpec As String
Dim oSld As Slide
Dim oPic As Shape
Dim fd As FileDialog


strFileSpec = "*.jpg"
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.AllowMultiSelect = False
If .Show = True Then
strPath = .SelectedItems(1)
End If
End With
If strPath = "" Then
Exit Sub ' no folder
Else
strPath = strPath & "\"
End If
strTemp = Dir(strPath & strFileSpec)
Do While strTemp <> ""
Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)
Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strTemp, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=60, _
Top:=32, _
Width:=1037, _
Height:=742)

' Get the next file that meets the spec and go round again
strTemp = Dir

Loop
End Sub

RichardG118
08-31-2012, 01:03 AM
Worked like a dream! Thank you, on reading your code I think I missed off adding the \ to the end of the selected path and so was giving me nothing.

Thank you again for you help and time!

fulloffun
12-20-2012, 07:13 AM
richard, i would be very grateful if you could tweak the code to work for me on my POWERPOINT 2011 MAC OSX. i have tried the ones above and they don't seem to work. feel free to explain it to me as though o am a kid please. As my VB knowledge isn't great.
many thanks in advance.

John Wilson
12-20-2012, 07:21 AM
Not sure it woill ever work on a Mac but as a minimum Macs use : not \ so you would need to replace all of the path separators from \ to :