代碼如下:

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)每頁幻燈

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

'如果符合格式: 根據(jù)情況設定, 此處前三位構成為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