VBA code to import data from excel file to ppt.?
I have got a challenging job from my boss. I have 2000 product image (Jpg file) with their sales information in an excel file, here I have to make a PPT file where all the information will be there with image in the PPT.
Is it possible to import the product image and their information from excel file through VBA code per slide, if yes then please help me. It’s very important for me to done this job in the short time.
All the slides will be having a signal product image and their information; the formation structure will be same as is being shown below.
- 10 years agoFavorite Answer
This code requires
1. a file named book1.txt saved from Excel, uses save as type: "Text(Tab delimited)(*.txt)" , the Excel spreadsheet has column A & B, no headers/column titles, Column A is for pics file with full path e.g. c:\myfolder\mypic.jpg so it allows pics to be imported from multiple folders, Column B is for the information of the corresponding product image
2. when it is run, the above text file from Excel has to be in the same folder with the pptm file.
For setting the position of the text, please see the comments on the code
Please contact for more info or code modifications.
Dim strTemp As String
Dim strPath As String
Dim strFileSpec As String
Dim oSld As Slide
Dim oPic As Shape
strPath = ActivePresentation.Path
Set fs = CreateObject( "Scripting.FileSystemObject")
Set f = fs.OpenTextFile( strPath & "\book1.txt", 1, 0) 'book1.txt need to be "Text(Tab delimited)(*.txt)" when saved in Excel
Do While f.AtEndOfStream <> True
picDesc = Split( f.readline, Chr(9))
Set oSld = ActivePresentation.Slides.Add( ActivePresentation. Slides.Count + 1, ppLayoutBlank)
Set oPic = oSld.Shapes.AddPicture( FileName:=picDesc(0), _
'next 4 lines define TextBox(TB) position and dimensions in terms of those of slide
TBPosFromSlideLeftMargin = 0.1 'TB start at 10% of slide width from left to right
TBPosFromSlideTopMargin = 0.8 'TB start at 80% of slide height from top to bottom
TBpercentageOfSlideWidth = 0.8 'TB is 80% of the slide width
TBpercentageOfSlideHeight = 0.2 'TB is 20% of the slide height
Set oDes = oSld.Shapes.AddTextbox( msoTextOrientationHorizontal, _
ActivePresentation. PageSetup.SlideWidth * TBPosFromSlideLeftMargin, _
ActivePresentation. PageSetup.SlideHeight * TBPosFromSlideTopMargin, _
ActivePresentation. PageSetup.SlideWidth * TBpercentageOfSlideWidth, _
ActivePresentation. PageSetup.SlideHeight * TBpercentageOfSlideHeight)
.TextFrame.TextRange.Text = picDesc(1)
.ScaleHeight 1, msoTrue
.ScaleWidth 1, msoTrue
Dim appssw, appssh
appssw = ActivePresentation. PageSetup.SlideWidth
appssh = ActivePresentation. PageSetup.SlideHeight
.LockAspectRatio = msoTrue
If oPic.Width / oPic.Height > appssw / appssh Then
.Width = appssw
.Top = (appssh - oPic.Height) / 2
.Height = appssh
.Left = (appssw - oPic.Width) / 2
Set oPic = Nothing
Set oDes = Nothing
Set oSld = Nothing
Set f = Nothing
Set fs = Nothing
- Anonymous4 years ago
If it's always the same cells, with maybe different sheets, write a VBA program (macro) to do it. Otherwise, open both xls files and do it by hand (copy/paste).
- 4 years ago
I have a dump of images ~1000 images/icons along with the keywords/thumbnails on ppt s. While working on on other presentations, i would like to have a search button at RHS Top so that i can search the images by using keyword and i can insert when required. Is it possible?