Hi,
I have list of file names in excel and all those files with some other unwanted files (images) are present in one folder. Is there any way i can write a command or macro to extract the files listed in excel from the folder into PowerPoint slides automatically ? and if there is a way to do that, can i also import these files with specific size ?
best
Deep
You need really to give more detail (including how much you know!)
Assuming the folder is at "C:\Pics\" (change the code to suit) AND the list of images starts at "A1" then "A2" etc
Try this in PowerPoint (You will need to set a reference to Excel)
Sub Pic_Choose()
Dim i As Integer
Dim XLApp As Excel.Application
Dim pptSlide As Slide
Dim pptShape As Shape
Dim strFolder As String
strFolder = "C:\Pics\" ' change to suit
Set XLApp = GetObject(Class:="Excel.application")
Do Until IsEmpty(XLApp.Range("A1").Offset(i, 0))
Set pptSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)
Set pptShape = pptSlide.Shapes.AddPicture(FileName:=strFolder & XLApp.Range("A1").Offset(i, 0), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=10, Top:=10, Width:=-1, Height:=-1) '-1 =True (original size)
'to change size
pptShape.Width = 3 * 72 '=3 inches (72 points= 1 inch)
i = i + 1
Loop
End Sub
Hi, It worked very well but the output I am getting is one image per slide, I want all the images in one slide. Is it possible to do that ?
Thanks
Deep
the output of images also do not have title/file name. do you think is it possible to do that ?
It's possible to do both (assuming you mean have the image named the same as the filename) but you would need to say about how many images so that they could be sized to fit on the slide and what you expect the slide to look like. If you just want the images on the slide to be resized and positioned manually then that's easy.
Sub Pic_Choose()
Dim i As Integer
Dim XLApp As Excel.Application
Dim pptSlide As Slide
Dim pptShape As Shape
Dim strFolder As String
strFolder = "C:\Pics\" ' change to suit
Set XLApp = GetObject(Class:="Excel.application")
Do Until IsEmpty(XLApp.Range("A1").Offset(i, 0))
Set pptSlide = ActivePresentation.Slides(1)
Set pptShape = pptSlide.Shapes.AddPicture(FileName:=strFolder & XLApp.Range("A1").Offset(i, 0), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=10, Top:=10, Width:=-1, Height:=-1) '-1 =True (original size)
pptShape.Name = XLApp.Range("A1").Offset(i, 0)
'to change size
pptShape.Width = 3 * 72 '=3 inches (72 points= 1 inch)
i = i + 1
Loop
End Sub
You should be able to work out the math for placing the shapes evenly if that's what you ned.
It worked and thanks a lot for it. But it is importing all the images on top of each other which I have to manually re-arrange. can we do it something like what photo album in power point does, placing 4 images in each corner or within space to each other. It is still not importing with image file names.
other thing is , plz tell me when i am asking too much.
I have one folder which has many folder in it and each folder has images. I want to import all the images from subfolder in one slide and second subfolder in second slide and so on. is it possible ?
Yes that what I said
" If you just want the images on the slide to be resized and positioned manually then that's easy."
You will need to do some simple math to work out the left and top values for each picture.
Hi John,
No the thing is i cannot place them manually as i will have many slides with many images.
still my question is why the images do not import with the title or caption ?
I have one folder which has many folder in it and each folder has images. I want to import all the images from subfolder in one slide and second subfolder in second slide and so on. is it possible ?
Sub Pic_Choose()
Dim i As Integer
Dim XLApp As Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlWorksheet As Excel.Worksheet
Dim pptSlide As Slide
Dim pptShape As Shape
Dim strFolder As String
strFolder = "C:\Documents and Settings\380235\Desktop\New Folder (3)\adenylate kinase 7\"
Set XLApp = GetObject(Class:="Excel.application")
XLApp.Visible = True
Set xlWorkbook = XLApp.Workbooks.Open("C:\Documents and Settings\380235\Desktop\gene name for macros.xlsx", True, False)
Do Until IsEmpty(XLApp.Range("A1").Offset(i, 0))
Set pptSlide = ActivePresentation.Slides(1)
Set pptShape = pptSlide.Shapes.AddPicture(FileName:=strFolder & XLApp.Range("A1").Offset(i, 0), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=10, Top:=10, Width:=-1, Height:=-1)
pptShape.Name = XLApp.Range("A1").Offset(i, 0)
pptShape.Width = 3 * 72 '=3 inches (72 points= 1 inch)
i = i + 1
Loop
End Sub
Thant is my command looks like, not importing images with caption ?
The code I gave you only sets the name it doesn't add a caption. You would need to use something like this
pptShape.Name = XLApp.Range("A1").Offset(i, 0)
pptShape.Width = 3 * 72 '=3 inches (72 points= 1 inch)
With pptSlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=pptShape.Left, Top:=pptShape.Top + pptShape.Height, Width:=200, Height:=15)
.TextFrame.TextRange = pptShape.Name
End With
You will also need to do the math and set the original placement setting or they will all overlap.
I see you are opening the excel file. If Excel is closed when you run the code it will most likely fail to GetObject try CreateObject instead
Hi John,
I am not VBA professional so i did not get your point when you say "You will also need to do the math and set the original placement setting or they will all overlap"
Can you give me example of if I have 3 images in folder what kind of math i have to do and where i have to change ?
You would need to increase the LEFT setting by the picture width.
Sub Pic_Choose()
Dim i As Integer
Dim XLApp As Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlWorksheet As Excel.Worksheet
Dim pptSlide As Slide
Dim pptShape As Shape
Dim strFolder As String
Dim leftAdjust As Single
strFolder = "C:\Documents and Settings\380235\Desktop\New Folder (3)\adenylate kinase 7\"
Set XLApp = GetObject(Class:="Excel.application")
XLApp.Visible = True
Set xlWorkbook = XLApp.Workbooks.Open("C:\Documents and Settings\380235\Desktop\gene name for macros.xlsx", True, False)
Do Until IsEmpty(XLApp.Range("A1").Offset(i, 0))
Set pptSlide = ActivePresentation.Slides(1)
Set pptShape = pptSlide.Shapes.AddPicture(FileName:=strFolder & XLApp.Range("A1").Offset(i, 0), _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=10 + leftAdjust, Top:=10, Width:=-1, Height:=-1)
pptShape.Name = XLApp.Range("A1").Offset(i, 0)
pptShape.Width = 3 * 72 '=3 inches (72 points= 1 inch)
With pptSlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=pptShape.Left, Top:=pptShape.Top + pptShape.Height, Width:=200, Height:=15)
.TextFrame.TextRange = pptShape.Name
End With
leftAdjust = leftAdjust + 3 * 72
i = i + 1
Loop
End Sub
At some stage you would need to do something similar and increase the TOP setting and set leftAdjust back to zero to get a second row.
In a normal pres the slide width is 720
You are the best John, Thanks a lot