[vba]获取PPT幻灯片中的所有标题

Private Sub CommandButton1_Click()
    Me.Enabled = False
    getTitles
    Me.Enabled = True
End Sub




Sub getTitles()
    On Error Resume Next
    
    Dim oPres As Presentation
    Set oPres = Application.ActivePresentation
    
    Dim oSlide As Slide
    Dim oShape As Shape
    Dim tr As TextRange
    
    Dim sText As String
    
    Dim i As Long, j As Long
    
    '循环每页幻灯
    For i = 1 To oPres.Slides.Count
        Set oSlide = oPres.Slides.Item(i)
        
        '获取图形对象
        For j = 1 To oSlide.Shapes.Count
            Set oShape = oSlide.Shapes.Item(j)
            
            '如果有文字
            If oShape.TextFrame.HasText = msoTrue Then
                Set tr = oShape.TextFrame.TextRange
                
                sText = tr.Text
                '如果符合格式: 根据情况设定, 此处前三位构成为x.y
                If IsNumeric(Left(sText, 3)) Then
                    'MsgBox sText
                    TextBox1.SelStart = 65535
                    TextBox1.SelText = sText & vbCrLf
                    
                End If
                
                Set tr = Nothing
            End If
            
            Set oShape = Nothing
        Next
        
        Set oSlide = Nothing
    Next
    Set oPres = Nothing

End Sub