Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Office > PowerPoint

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 01-16-2015, 12:12 AM
djlee djlee is offline Windows 8 Office 2010 64bit
Novice
 
Join Date: Jan 2015
Posts: 19
djlee is on a distinguished road
Default Need to import a bunch of .png files from a folder

I import a lot of .png files into PowerPoint. Currently, I create a Photo Album to get the pics in PowerPoint and then I copy those slides to my current presentation. Doing this manually has become quite inefficient and I need a easier way. I installed PowerPoint 2003 and tried to record the macro I need, but the recorder would not capture anything while the photo album dialog box was open. I was so bummed. :-(



So I'm looking for a macro to:

1. Insert *.png from a specified folder to the current slide
2. Tell me how many images were imported
3. Delete the .png files from the folder

Can somebody help me with this macro, please? I will be soooo grateful! :-)

DJ
Reply With Quote
  #2  
Old 01-16-2015, 06:47 AM
JohnWilson JohnWilson is online now Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,706
JohnWilson will become famous soon enoughJohnWilson will become famous soon enough
Default

See if this does it:

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


based on code from here:
http://www.pptfaq.com/FAQ00352_Batch..._per_slide.htm
__________________
Microsoft PowerPoint MVP
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #3  
Old 01-16-2015, 07:32 AM
djlee djlee is offline Windows 8 Office 2010 64bit
Novice
 
Join Date: Jan 2015
Posts: 19
djlee is on a distinguished road
Default

THANKS! I'm about to try it now. Before I do... do you know why this line is red?

Set oSld = ActivePresentation.Slides.Add(ActivePresentation.S lides.Count + 1, ppLayoutBlank)

DJ
Reply With Quote
  #4  
Old 01-16-2015, 07:38 AM
djlee djlee is offline Windows 8 Office 2010 64bit
Novice
 
Join Date: Jan 2015
Posts: 19
djlee is on a distinguished road
Default

It looks like you're resizing the images to 150 points less than slide height. Can I just comment out those lines? I don't need space for title boxes. I need the pics to fill the slides which they will do at their original size.

DJ
Reply With Quote
  #5  
Old 01-16-2015, 07:56 AM
JohnWilson JohnWilson is online now Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,706
JohnWilson will become famous soon enoughJohnWilson will become famous soon enough
Default

Thjios website has inserted an extra space that wasn't in the original

In the line in red (error) S lides should be Slides

Try .height=SH and .Top=0 to make the slide full size

You could also say .Left=0 but the calcualtion should already give 0

When it works please go back to the other post and say it was solved. This stops people wasting time working on another solution.
__________________
Microsoft PowerPoint MVP
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #6  
Old 01-16-2015, 08:04 AM
djlee djlee is offline Windows 8 Office 2010 64bit
Novice
 
Join Date: Jan 2015
Posts: 19
djlee is on a distinguished road
Default

This is working GREAT! I feel more efficient already!! :-)

I corrected the syntax error. There was a space in "slides".

Can you make the images import in order of creation time instead of by name?

DJ
Reply With Quote
  #7  
Old 01-16-2015, 08:20 AM
djlee djlee is offline Windows 8 Office 2010 64bit
Novice
 
Join Date: Jan 2015
Posts: 19
djlee is on a distinguished road
Default

I edited the resize commands. They're good!

I'm very happy. Just need to import by creation date. :-)

DJ
Reply With Quote
  #8  
Old 01-16-2015, 08:34 AM
JohnWilson JohnWilson is online now Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,706
JohnWilson will become famous soon enoughJohnWilson will become famous soon enough
Default

Can be done but complicated and way beyond the scope here.

You would need to load the file paths into an array and sort it by date created using the file system object to read this value. Not simple at all.
__________________
Microsoft PowerPoint MVP
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #9  
Old 01-16-2015, 08:43 AM
djlee djlee is offline Windows 8 Office 2010 64bit
Novice
 
Join Date: Jan 2015
Posts: 19
djlee is on a distinguished road
Default

Thanks for the heads up on the creation date thing!

I also use this pptfaq macro. http://www.pptfaq.com/FAQ00780_Copy_...esentation.htm

Can these lines be incorporated into your code?

Code:
Sub SuperDuper())

	Dim oSh as Shape
	Dim x as Long

	Set oSh=ActiveWindow.Selection.ShapeRange(1)
	oSh.Copy

	For x = 2 to ActivePresentation.Slides.Count
		ActivePresentation.Slides(x).Shapes.Paste
	Next

End Sub
The shape I want to copy is on slide 2. It's multiple shapes, actually and they are the only thing on slide 2. So I want to copy everything on slide 2 on top of each pic that was just imported.

Any chance I can get you to make this last change for me?

DJ
Reply With Quote
  #10  
Old 01-16-2015, 08:57 AM
djlee djlee is offline Windows 8 Office 2010 64bit
Novice
 
Join Date: Jan 2015
Posts: 19
djlee is on a distinguished road
Default

I resolved the date creation issue by changing the naming convention of the pics to include seconds. Yay!

DJ
Reply With Quote
  #11  
Old 01-16-2015, 09:10 AM
JohnWilson JohnWilson is online now Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,706
JohnWilson will become famous soon enoughJohnWilson will become famous soon enough
Default

This is how to modify Steve's code. I'll leave you to incorporate it as a little exercise!

Sub SuperDuper()

Dim oSh As ShapeRange
Dim x As Long

Set oSh = ActivePresentation.Slides(2).Shapes.Range
oSh.Copy

For x = 3 To ActivePresentation.Slides.Count
ActivePresentation.Slides(x).Shapes.Paste
Next

End Sub
__________________
Microsoft PowerPoint MVP
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #12  
Old 01-16-2015, 09:30 AM
djlee djlee is offline Windows 8 Office 2010 64bit
Novice
 
Join Date: Jan 2015
Posts: 19
djlee is on a distinguished road
Default

Cool beans!! I'll get right on it! :-)

DJ
Reply With Quote
  #13  
Old 01-16-2015, 09:37 AM
djlee djlee is offline Windows 8 Office 2010 64bit
Novice
 
Join Date: Jan 2015
Posts: 19
djlee is on a distinguished road
Default

I put my shapes on slide 2. I put the Dims up top with the other Dims. I put the rest under the reset lines.

I'm getting "type mismatch" on this
Set oSh = ActivePresentation.Slides(2).Shapes.Range

DJ
Reply With Quote
  #14  
Old 01-16-2015, 12:28 PM
JohnWilson JohnWilson is online now Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,706
JohnWilson will become famous soon enoughJohnWilson will become famous soon enough
Default

Did you declare (DIM) osh as a SHAPERANGE? (Not a shape)
__________________
Microsoft PowerPoint MVP
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #15  
Old 01-16-2015, 02:03 PM
djlee djlee is offline Windows 8 Office 2010 64bit
Novice
 
Join Date: Jan 2015
Posts: 19
djlee is on a distinguished road
Default

Oh, I don't know how I missed that. I thought I copied and pasted.

Fixed that line. No error now. But I am getting the shapes copied multiple times on each slide. I don't know how to make the copy and paste command apply only once to each new slide.

And I don't know how to make them insert at the current slide instead of the end.

I'm ready for my next exercise! :-)

DJ
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
macro, data import from the ONLY text file in current folder ue418 Excel Programming 5 10-28-2017 12:52 PM
Import from .CUB files in MS Access vamsikrishnad Office 0 12-30-2014 03:19 AM
Import msg-files to Outlook Jeff10 Outlook 0 01-19-2013 10:56 AM
Import Multiple XML Files TallKewlOnez Excel Programming 1 04-09-2012 05:19 PM
How might I group a bunch of text boxes without getting a space around the edge? Augusta PowerPoint 0 08-25-2011 01:42 AM


All times are GMT -7. The time now is 07:01 AM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft