cnadams
11-24-2014, 03:29 AM
I have written a script that opens a folder and using InsertFromFile combines any pptx files in the folder into a single presentation. The works well apart from when it has completed running any images on the original presentations are shown on the new presentation with "This image cannot currently be displayed and a red x". I am using powerpoint 2013, any suggestion on how I work around or fix this?
CODE:
Sub CompileModuleScript()
' Script allows user to select a folder docx files within folder will then be joined together into a
' single file
Dim fldr As FileDialog
Dim strDirectory As String
Dim strFolderFiles() As String
Dim X As Integer, Y As Integer
Dim strTemp As String
Dim strWorkingDirectory As String
X = 0
' Open Folder Dialog picker box
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = "c:\"
If .Show <> -1 Then Exit Sub
strDirectory = .SelectedItems(1)
End With
' Sets the working directory to that selected by users
strWorkingDirectory = strDirectory
strDirectory = Dir(strDirectory & "\*.pptx")
' Reads all the files into a array
Do While strDirectory <> ""
X = X + 1
ReDim Preserve strFolderFiles(1 To X)
strFolderFiles(X) = strDirectory
strDirectory = Dir()
Loop
X = 0
' Alphabetically sorts the array
For X = LBound(strFolderFiles) To UBound(strFolderFiles)
For Y = (X + 1) To UBound(strFolderFiles)
If strFolderFiles(X) > strFolderFiles(Y) Then
strTemp = strFolderFiles(X)
strFolderFiles(X) = strFolderFiles(Y)
strFolderFiles(Y) = strTemp
strTemp = ""
End If
Next Y
Next X
Y = 0
X = 0
' Joins the files together in the arrary into single file
For X = LBound(strFolderFiles) To UBound(strFolderFiles)
Y = ActivePresentation.Slides.Count
ActivePresentation.Slides.InsertFromFile FileName:=strWorkingDirectory & "\" & strFolderFiles(X), Index:=Y
Next X
End Sub
CODE:
Sub CompileModuleScript()
' Script allows user to select a folder docx files within folder will then be joined together into a
' single file
Dim fldr As FileDialog
Dim strDirectory As String
Dim strFolderFiles() As String
Dim X As Integer, Y As Integer
Dim strTemp As String
Dim strWorkingDirectory As String
X = 0
' Open Folder Dialog picker box
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = "c:\"
If .Show <> -1 Then Exit Sub
strDirectory = .SelectedItems(1)
End With
' Sets the working directory to that selected by users
strWorkingDirectory = strDirectory
strDirectory = Dir(strDirectory & "\*.pptx")
' Reads all the files into a array
Do While strDirectory <> ""
X = X + 1
ReDim Preserve strFolderFiles(1 To X)
strFolderFiles(X) = strDirectory
strDirectory = Dir()
Loop
X = 0
' Alphabetically sorts the array
For X = LBound(strFolderFiles) To UBound(strFolderFiles)
For Y = (X + 1) To UBound(strFolderFiles)
If strFolderFiles(X) > strFolderFiles(Y) Then
strTemp = strFolderFiles(X)
strFolderFiles(X) = strFolderFiles(Y)
strFolderFiles(Y) = strTemp
strTemp = ""
End If
Next Y
Next X
Y = 0
X = 0
' Joins the files together in the arrary into single file
For X = LBound(strFolderFiles) To UBound(strFolderFiles)
Y = ActivePresentation.Slides.Count
ActivePresentation.Slides.InsertFromFile FileName:=strWorkingDirectory & "\" & strFolderFiles(X), Index:=Y
Next X
End Sub