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
© 版权声明
文章版权归作者所有，未经允许请勿转载。
相关文章
