如何让Shapes.HasTitle找到演示文稿(VBA，.ppt)中的所有标题？

Question

我试图从一个演示文稿中提取所有标题到一个带有页面索引的excel电子表格中。我的代码总体上运行得相对较好，但不幸的是并不是每个标题都能读懂。

我基本上使用了Shapes.HasTitle方法，我的代码有点草率(循环一次来设置将要使用的数组的大小，然后填充数组)，但在其他方面相对简单。

Dim sld As Slide
Dim ppt As PowerPoint.Presentation
Dim wb As Workbook
Dim table As Range
Dim bottomLeft As Range
Dim titlesNPages() As Variant

Set wb = ThisWorkbook
myFileName = Application.GetOpenFilename(filefilter:="PowerPoint Files,*.ppt*;*.pptx*")
If myFileName <> False Then
    Set ppt = PowerPointApp.Presentations.Open(myFileName)
End If

'Setting array to the right size (# of shapes with title)
For Each sld In ppt.slides
    With sld
        If .Shapes.HasTitle Then
            i = i + 1
        End If
    End With
Next sld
ReDim titlesNPages(1 To 2, 1 To i)

i = 0

'Populating array
For Each sld In ppt.slides
    With sld
        If .Shapes.HasTitle Then
        i = i + 1
            titlesNPages(1, i) = .SlideIndex 'Page index
            titlesNPages(2, i) = .Shapes.Title.TextFrame.TextRange.Text 'Title
        End If
    End With
Next sld

With wb.Worksheets("Sheet1")
    Set bottomLeft = .Range("B3").Offset(UBound(titlesNPages, 2) - 1, 1)
    Set table = .Range("B3:" & bottomLeft.Address)
    table.Value = WorksheetFunction.Transpose(titlesNPages)
End With
End Sub

主要的问题是，Shapes.HasTitle似乎没有注意到所有标题的形状，也没有注意到用ppt制作的标题，而这些ppt是用英语以外的语言制作的。有什么想法可以让这个更好地工作吗？它目前接近70%的标题(然后我需要弄清楚如何处理实际上是标题的文本框)

Answer 1

这将在一个普通的演示文稿中获得所有标题。检查每个形状是否包含文本以及是否为占位符。如果两者都为真，则检查标题占位符格式：

Sub GetTitles()
  Dim oSlide As Slide, oShape As Shape
  For Each oSlide In ActivePresentation.Slides
    For Each oShape In oSlide.Shapes
      If oShape.Type = msoPlaceholder And oShape.TextFrame.HasText Then
        If oShape.PlaceholderFormat.Type = ppPlaceholderTitle Or _
        oShape.PlaceholderFormat.Type = ppPlaceholderCenterTitle Then
          MsgBox oShape.TextFrame.TextRange.Text
        End If
      End If
    Next oShape
  Next oSlide
End Sub

如果您有用户为文本框改变了标题用途的卡片组，或者反之亦然，您可能需要根据使用的文本大小进行更多检查，并查看形状位置是否在标题的正确区域中。