非分之想，跨版本求助：能否用查找法在幻灯片上实现答案的提取？

weiyingde

本是ppt板块的问题，可是该板块有求无应，求助常常石沉大海，无奈在此处求助了。
有一个用VBA从word文档转换而成的ppt幻灯片，全部都是选择题，每页幻灯片一道题目，转换的过程中，答案都在每张的括号里，现在想将他们批量提出来另加一个文本框放在各自原来地方。
要求用VBA实现。
1.下列各项中，朗读的奏划分正确的一项是（ D ）
A.故乡的歌/是一支/清远的笛，总/在有月亮的晚上/响起
B.开轩/面/场圃，把酒/话桑/麻
C.故/天/将降大任/于是人也
D.有的人/活着/他/已经/死了；有的人/死了/他/还活着
2.选出诵读时节奏划分正确的一项。（B）
A.梳洗／罢，独／倚望／江楼。
B.右手／秉／遗穗，左臂／悬／敝筐。
C.无可／奈何／花落／去，似曾／相识／燕归／来。
D.采菊／东／篱下，悠然／见南／山。
想法是：
利用查找法，遍历各张幻灯片，将各张中括号里的答案提出来，存入数组，然后再在每张幻灯片插入一个文本框，并用循环数组元素的方式向每个文本框框中输入文字。
要求：用查找和剪切的方法将所有答案写入数组之中。

小花鹿

研究PPTVBA的不多，可以通过录制宏的方法试一下

weiyingde

ppt2010没有录制宏的，不知怎么实现。

小花鹿

weiyingde 发表于 2017-5-16 11:36
ppt2010没有录制宏的，不知怎么实现。

你不会到03里去录制啊

weiyingde

我发现ppt03很多的过程都不能录制下来，特别是涉及到添加shape或处理图片的操作，操作完成后，打开录制的宏，发现只有一个标题而已，不知是什么原因。

weiyingde

weiyingde 发表于 2017-5-16 12:02
我发现ppt03很多的过程都不能录制下来，特别是涉及到添加shape或处理图片的操作，操作完成后，打开录制的宏 ...

转个弯，天地宽。
ppt中原来没有word中功能齐备的查找替换，那好吧，先在word中处理，写入数组，然后再写进新创建的ppt中。office的办公组件真是珠联璧合。
山不转路转，此话不假！！
拐弯的思路见：
http://club.excelhome.net/thread-1346783-1-1.html

leikaiyi123

老师，你是不是走弯路了？我发现你这个ppt的最终目的很像那个风靡全ppt的“挖词填空”功能哟？只是多一个 查找、选中的循环罢了。

leikaiyi123

weiyingde 发表于 2017-5-18 21:23
转个弯，天地宽。
ppt中原来没有word中功能齐备的查找替换，那好吧，先在word中处理，写入数组，然后 ...

ppt中的查找举两个例：
Sub pptFind1()
    For Each oSlide In ActivePresentation.Slides
        For Each oShape In oSlide.Shapes
            Set oTxtRange = oShape.TextFrame.TextRange
            If oShape.HasTextFrame Then
                Set oTxtRange = oShape.TextFrame.TextRange
                For i = 2 To Len(oTxtRange)    '所有字母、右括号、下标数字后的数字转成下标
                    If oTxtRange.Characters(i).Text Like "[A-D]" Then
                        oTxtRange.Characters(i).Select
                        '挖词填空code
                    End If
                Next
            End If
        Next
    Next
End Sub
Sub pptFind2()
    For Each oSlide In ActivePresentation.Slides
        For Each oShape In oSlide.Shapes
            Set oTxtRange = oShape.TextFrame.TextRange
            If oShape.HasTextFrame Then
                Set oTxtRange = oShape.TextFrame.TextRange
                Set foundText = oTxtRange.Find(FindWhat:="(A)") '此处根据需要修改，能否用正则？我不太懂
                Do While Not (foundText Is Nothing)
                    With foundText
                        .Characters(Start:=Len("(A)") - 1).Select    '离子的倒数第二位上标
                        '挖词填空code
                        Set foundText = oTxtRange.Find(FindWhat:="(A)", After:=.Start + .Length - 1)
                    End With
                Loop
            End If
        Next
    Next
End Sub当然这只是一个思路，重新画了一个文本框后，又会被查找，所以能用正则最好，不然会出问题

weiyingde

leikaiyi123 发表于 2017-8-16 19:46
ppt中的查找举两个例：
Sub pptFind1()
    For Each oSlide In ActivePresentation.Slides

思路是可以的，谢谢。
两点说明：
1、我的本意是将word文本转换为ppt，而帖中的内容只是其中的一个环节，当时没有好的方案，只好在ppt中寻找。现在已经找到了实现这个目的途径。
2、你的代码，可能在效率速度上，不及我的代码（在此没有公布）。
不过，还是谢谢你。

leikaiyi123

请大师帮助下http://club.excelhome.net/thread-1363903-1-1.html