Questions

VB code to import two images per slide in ppt 2007 along with related info

Tags:
+
0 Votes
Locked

VB code to import two images per slide in ppt 2007 along with related info

sendtosant
Dear VBA Experts,
I have received a VBA code from a gentle men through the yahoo site, the code is being used BY me to import the images & its information in the ppt 2007 from a folder.
In the folder all the images are there, in the same folder I have a txt file also in which all the information is incorporated along with images path.
The code is importing the image with its information per slide one image; here I want to import two images per slide with the information.

The code is being written below, request you to please make the rectification in below written code as per my requirement.
Any help will be highly appreciated.

Sub ImportABunchWithTextFromFile()
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(ActivePres??? + 1, ppLayoutBlank)
Set oPic = oSld.Shapes.AddPicture(FileName:=picDesc??? _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=0, _
Top:=0, _
Width:=0, _
Height:=0)
'next 4 lines define TextBox(TB) position and dimensions in terms of those of slide
TBLeftFromSlideLeft = 416 'this can be changed
TBTopFromSlideTop = 150 'this can be changed
TBWidth = 300 'this can be changed
TBHeight = 370 'this can be changed
Set oDes = oSld.Shapes.AddTextbox(msoTextOrientatio??? _
TBLeftFromSlideLeft, _
TBTopFromSlideTop, _
TBWidth, _
TBHeight)
For a = 1 To UBound(picDesc)
myText = myText & Chr(13) & picDesc(a)
Next
myText = Right(myText, Len(myText) - 1)
With oDes
.TextFrame.TextRange.Text = myText
End With
myText = ""


With oPic
.ScaleHeight 1, msoTrue
.ScaleWidth 1, msoTrue
End With

With oPic
Dim appssw, appssh
'next 4 lines set the distance between the image display area margins and the slide margins, image display area width and height
imageTopFromSlideTop = 50 'this can be changed
imageLeftFromSlideLeft = 10 'this can be changed
maxImageWidth = 400 'this can be changed
maxImageHeight = 400 'this can be changed
appssw = maxImageWidth
appssh = maxImageHeight
.LockAspectRatio = msoTrue
If oPic.Width / oPic.Height > appssw / appssh Then
.Width = appssw
.Top = (appssh - oPic.Height) / 2 + imageTopFromSlideTop
.Left = imageLeftFromSlideLeft
Else
.Height = appssh
.Left = (appssw - oPic.Width) / 2 + imageLeftFromSlideLeft / 2
.Top = imageTopFromSlideTop
End If
End With
Set oPic = Nothing
Set oDes = Nothing
Set oSld = Nothing
Loop
Set f = Nothing
Set fs = Nothing
End Sub