Automate Picture Insertion

[mac7attack]

Using a PPT macro/form, is there a way for a user to browse for a folder and the macro use the folder to insert an unknown number of pictures from that folder?
The pictures would have a format like Img001.jpg
But the "Img" and ".jpg" being defined by the user in the form

Thanks
Matt

 

[glenntb]

Hi Matt... I wrote this awhile to back to do something similar. The directory holding the pictures is hard-coded in this example ("C:\temp\&quot, but it shouldn't be too hard to use a variable populated from a form. Each picture is loaded on a new slide, and is loaded as a background image so that it fills the whole slide area.

Sub AutomaticallyCreateAPresentation()
'
' Automatically creates a presentation of pictures
'
Dim fso, fldr, subFldr, oFiles, oFile

Set fso = CreateObject("Scripting.FileSystemObject&quot
Set fldr = fso.GetFolder("C:\temp\&quot

Set oFiles = fldr.Files
Rw = 1
For Each oFile In oFiles

ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add(Index:=ActivePresentation.Slides.Count, Layout:=ppLayoutBlank).SlideIndex
With ActiveWindow.Selection.SlideRange
.FollowMasterBackground = msoFalse
.DisplayMasterShapes = msoTrue
With .Background
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.BackColor.SchemeColor = ppAccent1
.Fill.Transparency = 0#
.Fill.UserPicture oFile
End With
End With

Next oFile
End Sub

Hope this helps!

Glenn

 

[mac7attack]

Wow Glenn
Thats easier than what I figured out to do.
I set up a form so that the user could browse for one picture and the form would shorten the filename and then do a filesearch in that folder. Then the form inserted them as images onto the slides.

Thanks,
MAtt

 

[mac7attack]

Heres my code. I know its ugly, but it works. There is also code at the end to change the transition properties of all the slides. Btw, i dont have any underscores in my code.

Private Sub CommandButton4_Click()
'File Search and insert
Dim Folder As String
Dim X As String
Dim Num As Integer
Folder = TextBox1.Value
Num = InStrRev(Folder, "\&quot
Folder = Left(Folder, Num)
Set fs = Application.FileSearch
With fs
.LookIn = Folder
.FileName = "*.jpg"
If .Execute(SortBy:=msoSortByFileName,_ SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox "There were " & .FoundFiles.Count &_
" file(s) found in folder, " & Folder
For i = 1 To .FoundFiles.Count
X = .FoundFiles(i)
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=X, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=0, Top:=0, Width:=720, Height:=540).Select
ActiveWindow.Selection.ShapeRange.LockAspectRatio =_ msoFalse
ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add(Index:=1,_ Layout:=ppLayoutBlank).SlideIndex
ActivePresentation.Slides.Range(Array(1)).Select
Next i
Else
MsgBox "There were no files found."
Exit Sub
End If
End With

Dim TmSet As Integer
If IsEmpty(TmCtrl.Value) = True Then
TmSet = TmCtrl.Value
With ActivePresentation.Slides.Range.SlideShowTransition
.EntryEffect = ppEffectNone
.AdvanceOnClick = msoTrue
.AdvanceOnTime = msoTrue
.AdvanceTime = TmSet
.SoundEffect.Type = ppSoundNone
End With
End If
End Sub

 

[SenorJones]

I'm trying to do a similar thing people but I have pre-defined names for the files I am looking for. To generate the file names I am concatonating a list to the locations (for example) c3 thru to c9 based on criteria of say all fotos of son number 3. Then with the contents of those cells I want to insert the matching files from external location into current file. My problem is simply getting the macro to identify changing cell contents. I can get 1 pic / file in but only a fixed name, not a changing one. I'm sure this is simple but I'm a novice.
Thanks appreciated.

"Deliver MORE than you promise"