PDA

View Full Version : [SOLVED:] Merge multiple PPT slides into one presentation in order



leftee
12-05-2014, 11:41 AM
Hello - I have some code that I got from another site and it worked great the first time. Now it seems to updating the wrong slides. Here is what I am trying to do - I have 19 .ppt presntations that I have linked to a couple excel files. I update them monthly. This part works fine. I then have a "Master" .ppt presentation that I need to merge the 19 .ppt presentation into. I created a LIST.TXT so that the slides will insert in a certain order. The code works except it keeps updating (or at least runs) with last months data. Can anyone help me? The code is below. The 19 .ppt presentations is updated and has the current data. I do not know why it wont read the new data.

Sub InsertFromList()
' Inserts all presentations named in LIST.TXT into current presentation
' in list order
' LIST.TXT must be properly formatted, one full path name per line


On Error GoTo ErrorHandler


Dim sListFileName As String
Dim sListFilePath As String
Dim iListFileNum As Integer
Dim sBuf As String


' EDIT THESE AS NEEDED
' name of file containing files to be inserted
sListFileName = "List.TXT"


' backslash terminated path to filder containing list file:
sListFilePath = "N:\Corporate Sourcing\Amy\00_KPI Data Files\Monthly Presentation\Monthly Presentation Assembly Parts\"


' Do we have a file open already?
If Not Presentations.Count > 0 Then
Exit Sub
End If


' If LIST.TXT file doesn't exist, create it
If Len(Dir$(sListFilePath & sListFileName)) = 0 Then
iListFileNum = FreeFile()
Open sListFilePath & sListFileName For Output As iListFileNum
' get file names
sBuf = Dir$(sListFilePath & "*.PPTX")
While Not sBuf = ""
Print #iListFileNum, sBuf
sBuf = Dir$
Wend
Close #iListFileNum
End If


iListFileNum = FreeFile()
Open sListFilePath & sListFileName For Input As iListFileNum
' Process the list
While Not EOF(iListFileNum)
' Get a line from the list file
Line Input #iListFileNum, sBuf


' Verify that the file named on the line exists
If Dir$(sBuf) <> "" Then
Call ActivePresentation.Slides.InsertFromFile( _
sBuf, ActivePresentation.Slides.Count)
End If
Wend


Close #iListFileNum
MsgBox "DONE!"


NormalExit:
Exit Sub
ErrorHandler:
Call MsgBox("Error:" & vbCrLf & Err.Number & vbCrLf & Err.Description, _
vbOKOnly, "Error inserting files")
Resume NormalExit
End Sub

John Wilson
12-06-2014, 02:23 AM
Does the text file have the full path to the files or just the name.

Can you post an example?