VBA PowerPoint 幻燈片標題

Question

我正在開發一種自定義工具，可以為給定的演示文稿生成自定義的講師筆記。 我在處理演示文稿時遇到問題，其中幻燈片上基本上沒有 Title 對象然后我運行了代碼，它使用 .

我已將代碼簡化為基礎，以使其盡可能簡單。

我的測試課有一張填充了文本占位符的普通幻燈片，下一張幻燈片是一個沒有標題文本框的徽標幻燈片，只有一個版權信息和徽標（這是有問題的幻燈片），然后是另一張幻燈片標題占位符存在，但留空。

如何檢查單個幻燈片以確保標題占位符存在？

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 集合的 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