Question: I am using the Slides.InsertFromFile method in VBA in order to insert slides from a PowerPoint presentation called FinalPPTX onto a PowerPoint Presentation called Omnibus beginning at a specified slide number:
FileInsert = OmnibusPresentation.Slides.InsertFromFile(temp & FinalPPTX, slideNumber)The code works. However the custom layout on the slides from FinalPPTX are not carried over into the Omnibus presentation. How might I correct this ?
I figured it out myself:
Dim FileInsert As Long
FileInsert = OmnibusPresentation.Slides.InsertFromFile(temp & FinalPPTX, slideNumber)
OmnibusPresentation.Slides(slideNumber).DeleteHello everyone. This is my first time asking a question. I have a VBA problem that I am trying to solve. I am certain I have approached the problem correctly and am close to solving it.
Brief Description:
I want to insert a presentation FinalPPTXPresentation onto OmnibusPresentation after a specifying a slide number on OmnibusPresentation.
Long Description:
The goals is to have a VBA script that would loop through a folder called Test; which contains Omnibus.pptx, and find amongst its subfolders the path Test\ 0X.stringX \ Y.stringY \ Final \ Final.pptx and extract the value 0X.Y and then search Omnibus.pptx and locate the slide containing the text "Placeholder for slides from 0X.Y.". Once found it would remove that slide and insert the presentation Final.pptx.
I have everything I need but the final punch; which is inserting one powerpoint presentation into another at a specific slide number. Note: My VBA code is contained on a module in Excel and not a pptx file. Whence the Excel tag.
The "main" module:
'VBA Script to Generate PPT presentation
Public Sub BuildOmnibusPointPresentation()
Call RecursivelySearchFolder("\\company.com\abc\def\ghi\jkl\mno\pqr\Test set up")
End SubRecursively search folders and subfolders:
Public Function RecursivelySearchFolder(sPath As String) As String
'Recursively search through folder and all subfolders in order to find pptx files: complete 4/20/2020
Dim FSO As New FileSystemObject
Dim myFolder As Folder
Dim mySubFolder As Folder
Set myFolder = FSO.GetFolder(sPath)
For Each mySubFolder In myFolder.SubFolders
Call RetrieveFinalPPTX(mySubFolder.Path)
RecursivelySearchFolder = RecursivelySearchFolder(mySubFolder.Path)
Next
End FunctionExtract placeholder index from folder structure. This is subtle. But what this nifty script does extract characters from a given string and concatenates them:
Public Function fGetPlaceHolderIndex(strInput As String) As String
'Recursively search through file directory names and get placement holder index: complete 4/21/2020
Dim aData() As String
Dim lngLoop1 As Long
aData = Split(strInput, "\")
For lngLoop1 = 3 To UBound(aData)
If InStr(aData(lngLoop1), ".") > 0 Then
fGetPlaceHolderIndex = fGetPlaceHolderIndex & Left(aData(lngLoop1), InStr(aData(lngLoop1), "."))
End If
Next lngLoop1
If Right(fGetPlaceHolderIndex, 1) = "." Then fGetPlaceHolderIndex = Left(fGetPlaceHolderIndex, Len(fGetPlaceHolderIndex) - 1)
End FunctionThis is where my programming skills get muddle and I become confused - but it works.
Public Sub RetrieveFinalPPTX(ByVal s As String)
'Collect (-copy) powershell slides, per placeholderindex, and place accordingly into Omnibus
Dim FolderFinal As String
Dim PlaceHolderIndex As String
Dim PlaceHolderSearchString As String
Dim OmnibusPPTX As String
Dim FinalPPTX As String
Dim FinalPresentation As PowerPoint.Presentation
Dim PowerPointApp As PowerPoint.Application
Dim OmnibusPresentation As PowerPoint.Presentation
Dim FinalPPTXPresentation As PowerPoint.Presentation
Debug.Print s 'double check we are in the right directory
FolderFinal = Right(s, Len(s) - InStrRev(s, "\"))
If FolderFinal = "Final" Then
PlaceHolderIndex = fGetPlaceHolderIndex(s) '<-amazing
PlaceHolderSearchString = "[" & "Placeholder for slides from " & PlaceHolderIndex & "]"
OmnibusPPTX = "("\\company.com\abc\def\ghi\jkl\mno\pqr\Test set up"\Omnibus.pptx"
Dim temp As String
temp = s & "\"
FinalPPTX = Dir(temp & "\*." & "pptx")
Set PowerPointApp = CreateObject("PowerPoint.Application")
Set FinalPPTXPresentation = PowerPointApp.Presentations.Open(temp & FinalPPTX)
Set OmnibusPresentation = PowerPointApp.Presentations.Open(OmnibusPPTX)
Dim sld As Slide
For Each sld In OmnibusPresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
Set txtRng = shp.TextFrame.TextRange
Dim sldText As String
sldText = txtRng
If sldText = PlaceHolderSearchString Then
MsgBox ("Found It")'check in see if i found the correct slide.
MsgBox (sld.SlideNumber) 'check and get the slide number
'Code: remove placeholder sld and insert final <----STUCK
End If
End If
Next
Next
With FinalPPTXPresentation
'.Save
.Close
End With
With OmnibusPresentation
'.Save
.Close
End With
End If
End Sub