VBA for Photo Album

[djlee]

Does anyone know of code that will automate the creation of a photo album and then copy the slides (excluding the title slide) to new slides in the current presentation?

If not, anyone interested in writing it for me? Your help will be greatly appreciated! :-)

DJ

[djlee]

I tried to record the macro in PPT 2003, but the recorder doesn't capture the steps once the dialog box is open.

DJ

[John Wilson]

I don't think there's any way to do that from vba. You might be able to write vba that SIMULATES adding pictures from a folder.

[djlee]

Okay. I don't have to create a Photo Album in the process. That's just how I do it manually.

How about:
- Import *.png from a folder, fit to slide, on new slides inserted after the current slide.
- Tell me how many pics were imported.
- Delete *.png in the specified folder?

DJ

[djlee]

There's a macro at pptfaq that's close to what I'm looking for, but it doesn't insert at the current slide or give me a count or delete the files.

And I don't have the skill set to edit it. I'd surely appreciate your help!

DJ

[djlee]

I'll see it I can post a link to it.

DJ

[djlee]

The forum won't let me post the URL. Something about forbidden words. Weird!

DJ

[John Wilson]

Steve is a good friend so I can find it. I'm busy right now but I'll have a look when things calm at work.

[John Wilson]

See your other post

http://www.msofficeforums.com/powerpoint/24341-need-import-bunch-png-files-folder.html

[Paul_Hossler]

The forum won't let me post the URL. Something about forbidden words. Weird!


http://www.pptfaq.com/FAQ00352_Batch_Insert_a_folder_full_of_pictures-_one_per_slide.htm

That one seems to have a macro, but maybe this on talks about a AddIn

http://www.pptfaq.com/FAQ00050_BATCH_IMPORT_images_into_PowerPoint.htm

I think the first one seems more on target to a VBA approach


Finally, Shyam has a try-before-buy product

http://skp.mvps.org/iiw.htm

[Paul_Hossler]

A couple of things you can try (hopefully John can help me with the subtleties of PP VBA)

I personally don't like hard coded paths so I added a file dialog to select the file or files (Shift-click and/or Control-click)

I also decided that I liked the picture in a placeholder and not full screen but that's just me and I'm sure that it could be made an option




Option Explicit
Sub ImportABunch2()
Dim i As Long
Dim oSlide As Slide
Dim oPicture As Shape, oContentHolder As Shape


Dim dlgOpen As FileDialog

Set dlgOpen = Application.FileDialog(Type:=msoFileDialogOpen)
With dlgOpen
.AllowMultiSelect = True
.Show
End With

If dlgOpen.SelectedItems.Count = 0 Then Exit Sub

For i = 1 To dlgOpen.SelectedItems.Count

Set oSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutObject)

For Each oContentHolder In oSlide.Shapes
If oContentHolder.Type = msoPlaceholder And oContentHolder.PlaceholderFormat.ContainedType = msoAutoShape Then
Set oPicture = oSlide.Shapes.AddPicture(FileName:=dlgOpen.SelectedItems(i), _
LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Left:=0, Top:=0, Width:=100, Height:=100)
GoTo NextSlide
End If
Next

NextSlide:
Next i
End Sub

[djlee]

Thanks John!!

Here is the code, if anybody is interested.


Sub ImportABunch()
' based on code from pptfaq

Dim SW As Long
Dim SH As Long
Dim strTemp As String
Dim strPath As String
Dim strFileSpec As String
Dim oSld As Slide
Dim oPic As Shape
Dim iCount As Integer

' Edit these to suit:
strPath = "c:\Users\John\Desktop\Pics\"
strFileSpec = "*.png"
SH = ActivePresentation.PageSetup.SlideHeight
SW = ActivePresentation.PageSetup.SlideWidth
strTemp = Dir(strPath & strFileSpec)

Do While strTemp <> ""
Set oSld = ActivePresentation.Slides.Add(ActivePresentation.S lides.Count + 1, ppLayoutBlank)
iCount = iCount + 1
Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strTemp, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0, _
Width:=msoTrue, _
Height:=msoTrue)

'reset height to a 150points less than slide height
With oPic
.LockAspectRatio = msoTrue
.Height = SH - 150
.Left = (SW - oPic.Width) / 2
.Top = 100
End With
' Get the next file that meets the spec and go round again
strTemp = Dir
Loop
If MsgBox("I added " & iCount & " Images." & vbCrLf & "Would you like to delete the files? This cannot be reversed.", vbYesNo) = vbYes Then
Kill strPath & "*png"""
End If
End Sub


DJ

[djlee]

Thanks Paul. Your dialog box is cool!

DJ

[John Wilson]

@Paul

I think I would use the FOLDERPicker to select the target folder if all PNGs are going to be imported

Set dlgFolder = Application.FileDialog(Type:=msoFileDialogFolderPicker)
With dlgFolder
.Show
End With
if dlgFolder.SelectedItems.Count>0 then _
MsgBox dlgFolder.SelectedItems(1)

[Paul_Hossler]

@Paul

I think I would use the FOLDERPicker to select the target folder if all PNGs are going to be imported

Set dlgFolder = Application.FileDialog(Type:=msoFileDialogFolderPicker)
With dlgFolder
.Show
End With
if dlgFolder.SelectedItems.Count>0 then _
MsgBox dlgFolder.SelectedItems(1)


Yes, that would work but IMNSHO :rotlaugh: I can select all the files with a Control-A or some other way. It's just that I rarely do all. The OP can it that way if all the pictures will always be imported

[John Wilson]

Probably would work in most situations but in my case I have PNGs and JPGs in the test folder.

The mug on the desk also says

"You made it FOOLPROOF? -- Did you consider the ingenuity of fools?

[Paul_Hossler]

http://cdn.someecards.com/someecards/usercards/1340137958320_250077.png