VBA PowerPoint 幻灯片标题

Question

我正在开发一个自定义工具，可以为给定的演示文稿生成自定义的教师注释。我遇到一个问题，我正在处理一个演示文稿，其中幻灯片基本上没有 Title 对象然后我运行代码，它将我的 if 语句与 .

我已将代码简化为基础内容，以使其尽可能简单。

我的测试课程有一张正常的幻灯片，其中填充了文本占位符，下一张幻灯片是一张徽标幻灯片，没有标题文本框，只有版权信息和徽标（这是有问题的幻灯片），然后是另一张幻灯片，其中标题占位符存在，但留空。

如何检查单个幻灯片以确保标题占位符存在？

Public Sub GetTitle()
    Dim pres As Presentation    'PowerPoint presentation
    Dim sld As Slide            'Individual slide
    Dim shp As Shape            'EIAG Text Shape
    Dim ShpType As String       'Shape Type
    Dim SldTitle As String      'Slide TITLE

    'Go through each slide object
    Set pres = ActivePresentation
    For Each sld In ActivePresentation.Slides.Range
    On Error Resume Next
        If sld.Shapes(1).PlaceholderFormat.Type = ppPlaceholderCenterTitle Or sld.Shapes(1).PlaceholderFormat.Type = ppPlaceholderTitle Then
            If sld.Shapes.Title.TextFrame.TextRange <> "" Then
                SldTitle = sld.Shapes.Title.TextFrame.TextRange
                Debug.Print SldTitle & " - Slide: " & CStr(sld.SlideNumber)
            Else
                Debug.Print "BLANK TITLE - Slide: " & CStr(sld.SlideNumber)
            End If
        Else
            ShpType = sld.Shapes.Item(1).Type
            Debug.Print ShpType & "Not Processed There is no Title object"
        End If
    Next sld
End Sub

Answer 1

您可以使用 Shapes Collection 的 HastTitle 方法来检查幻灯片是否具有标题占位符：

If sld.Shapes.HasTitle then

您也不应该依赖形状 1 的标题占位符，而应该循环遍历幻灯片上的所有形状，按如下方式检查每个形状：

Option Explicit

' Function to return an array of title texts from a presentation
' Written by Jamie Garroch at http://youpresent.co.uk
' Inputs : None
' Outputs : Array of title strings
Function GetTitlesArr() As Variant
  Dim oSld As Slide
  Dim oShp As Shape
  Dim iCounter As Integer
  Dim arrTitles() As String
  For Each oSld In ActivePresentation.Slides
    For Each oShp In oSld.Shapes
      With oShp
        If .Type = msoPlaceholder Then
          Select Case .PlaceholderFormat.Type
            Case ppPlaceholderCenterTitle, ppPlaceholderTitle
              ReDim Preserve arrTitles(iCounter)
              arrTitles(iCounter) = oShp.TextFrame.TextRange.Text
              iCounter = iCounter + 1
          End Select
        End If
      End With
    Next
  Next
  GetTitlesArr = arrTitles
End Function