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

[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

 

posted on 2010-08-20 12:43 kmlxk 阅读( ...) 评论( ...) 编辑 收藏

转载于:https://www.cnblogs.com/snippet/archive/2010/08/20/1804452.html