如何获取PPT每一页标题栏的文字

beleqing

大家好，我现在创建了一段代码，用于在每一页PPT中插入和标题栏文字相同的音频文件，请问怎么提取PPT每一页标题栏的文字？我的每一页PPT的标题栏文字格式和位置完全相同。谢谢！


就是代码第16行里的word = "have"里面的"have"提取如何用代码实现？

1. Option Explicit
   
2. 
   
3. Sub SampleTest()
   
4. 
   
5. Dim a, b As Integer
   
6. Dim pptName As String
   
7. Dim pageNo As String
   
8. Dim word As String
   
9. 
   
10. Const med_dir As String = "C:\Users\Xu Tingting\Desktop\New folder\The Graham Norton Show S22E15\Vocab"
    
11. pptName = ActivePresentation.Name
    
12. pageNo = Left(pptName, 4)
    
13. 
    
14. For b = 1 To 3
    
15. 
    
16. word = "have"
    
17. Call InsertAudio(med_dir & pageNo & "_" & word & ".mp3", ActivePresentation.Slides(b))
    
18. 
    
19. Next b
    
20. 
    
21. End Sub
    
22. 
    
23. Sub InsertAudio(Track As String, oSlide As Slide)
    
24. 
    
25. Dim oShp As Shape
    
26. Dim oEffect As Effect
    
27. 'Add the audio shape
    
28. Set oShp = oSlide.Shapes.AddMediaObject2(Track, True, False, 10, 10)
    
29. 'Set audio to play automatically
    
30. Set oEffect = oSlide.TimeLine.MainSequence.AddEffect(oShp, msoAnimEffectMediaPlay, , msoAnimTriggerWithPrevious)
    
31. oEffect.MoveTo 1
    
32. 'Hide during slide show
    
33. With oEffect
    
34.     .EffectInformation.PlaySettings.HideWhileNotPlaying = True
    
35. End With
    
36. End Sub

复制代码

源文件在此，谢谢！

0000 The Graham Norton Show S22E15.zip (48.13 KB, 下载次数: 2)

2024-9-16 19:06 上传

点击文件名下载附件

Enocheasty

没有什么好办法可以直接找到你的标题栏，其实的标题栏也就是一个文本框，如果页面中还有其他文本框，跟标题栏没有区别。所以，如果想要找到所谓的“标题栏”，就是遍历当前页面所有的图形对象，找到你要的标题栏。这样依然有两个情况：
1、你知道找的内容是什么，也即是你有一个基础的List，至少你要找的都在List里面，那么就遍历图形，访问图形的文本内容，跟List的内容去比对。
2、你也不知道要找的是什么，那就更麻烦了，你要确定你所找的对象就是标题栏对象，可能你需要使用者通过你的程序创建所谓的标题栏对象，这样遍历图形时，寻找你程序创建的标题栏。
我之前做插件时也想讨论怎么效率的遍历或者查找目标图形https://club.excelhome.net/thread-1690699-1-1.html，似乎没人有兴趣。

lss001

Sub SampleTest()

Dim a, b%, pptName$, pageNo$, word$
Dim slds, sld As Slide, shp, xTop!, y!

Const med_dir As String = "C:\Users\Xu Tingting\Desktop\New folder\The Graham Norton Show S22E15\Vocab"
pptName = ActivePresentation.Name
pageNo = Left(pptName, 4)

Set slds = Application.ActivePresentation.Slides
xTop = 10 '指定文本框top位置
For Each sld In slds
    For Each shp In sld.Shapes
        y = shp.Top
        If y = xTop Then
            word = shp.TextFrame.TextRange.Text
            Exit For
        End If
    Next

Call InsertAudio(med_dir & pageNo & "_" & word & ".mp3", sld)

Next

End Sub