I would like to create an overview slide of all CustomLayouts in a regular presentation.

The following code raises an error -- neither does the approach work manually:

Sub CreateOverviewSlideFromLayouts()
    Dim myCustomLayout As CustomLayout
    Dim myBlankSlide As slide
    Set myBlankSlide = ActivePresentation.Slides.Add(Index:=2, Layout:=ppLayoutBlank)
    For Each myCustomLayout In ActivePresentation.Designs(1).slideMaster.CustomLayouts
        myCustomLayout.Copy
        myBlankSlide.Shapes.PasteSpecial ppPasteJPG '<== this raises an error
    Next myCustomLayout
End Sub

How can I copy a CustomLayout and insert that copy into a regular slide?

CodePudding user response：

This might help:

Sub ThemeSampler()

    Dim oSl As Slide
    Dim oSh As Shape
    Dim oLayout As CustomLayout
    Dim oDesign As Design
    Dim sPictureName As String
    
    ' Point to a picture that'll be used on some slide.
    ' change this to suit your needs:
    sPictureName = "C:\Users\Public\Pictures\Sample Pictures\Forest.jpg"
    
    With ActivePresentation
        For Each oDesign In .Designs
            For Each oLayout In oDesign.SlideMaster.CustomLayouts
                Set oSl = .Slides.AddSlide(.Slides.Count, oLayout)
                ' ID the slide:
                Set oSh = oSl.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 10, 300, 50)
                With oSh.TextFrame.TextRange
                    .Text = oLayout.Name
                End With
                ' now fill the slide's placeholders with stuff
                For Each oSh In oSl.Shapes
                    If oSh.Type = msoPlaceholder Then
                        Select Case oSh.PlaceholderFormat.Type
                            Case ppPlaceholderBody, ppPlaceholderVerticalBody
                                oSh.TextFrame.TextRange.Text = _
                                    "Bulleted text" & vbCrLf _
                                    & "Bulleted text" & vbCrLf
                            Case ppPlaceholderObject
                                oSh.TextFrame.TextRange.Text = _
                                    "Bulleted text" & vbCrLf _
                                    & "Bulleted text" & vbCrLf
                            
                            Case ppPlaceholderTitle, ppPlaceholderCenterTitle, ppPlaceholderVerticalTitle
                                oSh.TextFrame.TextRange.Text = "Slide Title"
                            
                            Case ppPlaceholderChart
                            
                            Case ppPlaceholderDate
                                oSh.TextFrame.TextRange.Text = "12/34/56"
                            
                            Case ppPlaceholderFooter
                                oSh.TextFrame.TextRange.Text = "Footer goes here"
                            
                            Case ppPlaceholderHeader
                                oSh.TextFrame.TextRange.Text = "Header goes here"
                            
                            Case ppPlaceholderMediaClip
                            
                            Case ppPlaceholderPicture
                                oSh.Fill.UserPicture (sPictureName)
                                
                            Case ppPlaceholderSubtitle
                                oSh.TextFrame.TextRange.Text = "Subtitle goes here"
                            Case ppPlaceholderTable
                                If oSh.HasTable Then
                                    oSh.Table.Cell(1, 1).Shape.TextFrame.TextRange.Text = "Cell 1,1"
                                    oSh.Table.Cell(5, 5).Shape.TextFrame.TextRange.Text = "Cell 5,5"
                                End If
                            
                        End Select
                    End If
                Next
            Next    ' Layout
        Next    ' Design
    End With
    

End Sub