应用特定布局PPT

Question

我有一段现有的代码(见下文)，用于导入一批照片和创建幻灯片放映。目前，代码仅在空白背景上创建带有标题的幻灯片。如何修改它，使其从主幻灯片中选择特定的幻灯片布局？我知道它与代码中的这一行有关：Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutTitleOnly)

我在这里寻找并尝试了一些想法，但我就是一直收到错误：Applying layout to a slide from specific Master

下面是完整的程序：

Sub ImportStuffFromTextFile()
Dim strTemp As String
Dim strPath As String
Dim strFileSpec As String
Dim oSld As Slide
Dim oPic As Shape
Dim fs As Object
Dim f As Object
Dim PicDesc() As String
Dim strFile As String
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Add "Text Files", "*.txt"
.AllowMultiSelect = False
.InitialFileName = ActivePresentation.Path
If .Show = -1 Then
strFile = .SelectedItems.Item(1)
End If
If strFile = "" Then Exit Sub
End With
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(strFile, 1, 0)
Do While Not f.AtEndOfStream
    PicDesc = Split(f.readline, Chr(9))
    Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutTitleOnly)
    Set oPic = oSld.Shapes.AddPicture(FileName:=PicDesc(0), _
                                      LinkToFile:=msoFalse, _
                                      SaveWithDocument:=msoTrue, _
                                      Left:=0, _
                                      Top:=0)
    If oSld.Shapes.HasTitle Then
        oSld.Shapes.Title.TextFrame.TextRange.Text = PicDesc(1)
        With oPic
            .Height = 469.875
            .Width = 626.325
            .Left = ActivePresentation.PageSetup.SlideWidth / 2 - .Width / 2
            .Top = oSld.Shapes.Title.Top + oSld.Shapes.Title.Height + 7
        End With
    End If
    Set oPic = Nothing
    Set oSld = Nothing
Loop
Set f = Nothing
Set fs = Nothing
End Sub

Answer 1

当你说你一直收到bug时，你是什么意思？

• 您是否收到错误消息？如果是，错误号/描述是什么？代码在哪里中断？
• 如果不是，你会得到‘bug’，最终的输出应该是什么样子，这与之有什么不同？

我想说，这里有一个很大的未知数，那就是文本文件输入。根据您的代码，它似乎需要在文本文件的每一行上有一系列的文件名和相应的图片描述，并用制表符分隔。重要的是，它必须是一个制表符，而不是2个空格或4个空格或10个空格或连字符...必须是制表符。这是用作输入的文本文件的结构吗？

Answer 2

PowerPoint对待内置布局的方式与对待自定义布局的方式不同。您不能通过名称调用自定义布局。相反，您必须遍历每个自定义布局以找到具有正确名称的布局，然后使用它：

Sub AddSlideFromCustomLayout()
    Dim oLayout As CustomLayout
    Dim oSlide As Slide
    For Each oLayout In ActivePresentation.SlideMaster.CustomLayouts
        If oLayout.Name = "Custom Layout Name" Then
            Set oSlide = ActivePresentation.Slides.AddSlide(ActivePresentation.Slides.Count + 1, oLayout)
        End If
    Next oLayout
End Sub

下面是用替换Set oSld行的代码编写的清单：

Sub ImportStuffFromTextFile()
    Dim oLayout As CustomLayout
    Dim strTemp As String
    Dim strPath As String
    Dim strFileSpec As String
    Dim oSld As Slide
    Dim oPic As Shape
    Dim fs As Object
    Dim f As Object
    Dim PicDesc() As String
    Dim strFile As String
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Add "Text Files", "*.txt"
        .AllowMultiSelect = False
        .InitialFileName = ActivePresentation.Path
        If .Show = -1 Then
            strFile = .SelectedItems.Item(1)
        End If
        If strFile = "" Then Exit Sub
    End With
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile(strFile, 1, 0)
    Do While Not f.AtEndOfStream
        PicDesc = Split(f.readline, Chr(9))
        For Each oLayout In ActivePresentation.SlideMaster.CustomLayouts
            If oLayout.Name = "Custom Layout Name" Then
                Set oSld = ActivePresentation.Slides.AddSlide(ActivePresentation.Slides.Count + 1, oLayout)
            End If
        Next oLayout
        Set oPic = oSld.Shapes.AddPicture(FileName:=PicDesc(0), LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=0, Top:=0)
        If oSld.Shapes.HasTitle Then
            oSld.Shapes.Title.TextFrame.TextRange.Text = PicDesc(1)
            With oPic
                .Height = 469.875
                .Width = 626.325
                .Left = ActivePresentation.PageSetup.SlideWidth / 2 - .Width / 2
                .Top = oSld.Shapes.Title.Top + oSld.Shapes.Title.Height + 7
            End With
        End If
        Set oPic = Nothing
        Set oSld = Nothing
    Loop
    Set f = Nothing
    Set fs = Nothing
End Sub