代码如下:
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