代碼如下:
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
'循環(huán)每頁(yè)幻燈
for i = 1 to opres.slides.count
set oslide = opres.slides.item(i)
'獲取圖形對(duì)象
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
'如果符合格式: 根據(jù)情況設(shè)定, 此處前三位構(gòu)成為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