[求助]批量替换英文改错题选项的代码

tangqingfu

http://club.excelhome.net/dispbbs.asp?boardid=23&replyid=636185&id=207360&page=1&skin=0&Star=2

在学习兄帖子“制作改错题的最佳办法是什么”后，在守版主等高手代码的基础上添加了一小段代码，进行批量替换英文改错题选项，但运行速度慢了些，请帮忙解决

实例如下：

46.  The professor told the economics [A] student that he didn’t approve in [C] his taking the advanced course before [D] he made a passing mark in Economics

Sub 批量替换英文改错题选项()
'将位于带下划线改错题右边的[A]、、[C]、[D]替换到下改错题的正下方
Dim myRange As Range, EqA As String, EqB As String
    Dim lngStart As Long, lngEnd As Long, myField As Field
    On Error Resume Next
    Application.ScreenUpdating = False
NF:     If myRange Is Nothing Then
        Set myRange = ActiveDocument.Content
    Else
        myRange.SetRange myRange.End, ActiveDocument.Content.End - 1
    End If
    With myRange.Find
        .ClearFormatting
        .Format = True
        .Font.Underline = True
        Do While .Execute
            With myRange
                lngStart = .Start
                EqA = .Text
                .SetRange .End, .End + 4
                lngEnd = .End
                EqB = .Text
                .SetRange lngStart, lngEnd
                .Delete
               Set myField = .Fields.Add(myRange, wdFieldEmpty, "ADVANCE  \u 8 ", False)
                Set myField = .Fields.Add(myRange, wdFieldEmpty, "EQ \F(" & EqA & "," & EqB & ")", False)
              Set myField = .Fields.Add(myRange, wdFieldEmpty, "ADVANCE  \d 8 ", False)
                myField.ShowCodes = False
                myField.Update
                GoTo NF
            End With
        Loop
        Application.ScreenUpdating = True
    End With
    With Selection.Find
ActiveWindow.View.ShowFieldCodes = True
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWildcards = True  '勾选“使用通配符”
    .Text = "\[([ABCD])\]"
    .Execute replacewith:="\1^32", Replace:=wdReplaceAll
ActiveWindow.View.ShowFieldCodes = False
    Selection.Fields.Update
    End With
End Sub

[此贴子已经被作者于2008-6-12 13:07:55编辑过]

sylun

以前曾练习做过（http://club.excelhome.net/viewthread.php?tid=313684&extra=&page=1#313684），觉得用插入文本框的方法容易还原，出题时无需输入ABC，不过感觉速度不够快。刚才对代码再作了点修改（原帖6楼），简单的测试文档基本可行，但实际应用不知如何。

[此贴子已经被作者于2008-6-13 0:15:49编辑过]

tangqingfu

To sylun兄:

不知在运行代码前该有哪些设置或操作?是将内容放在文本框中吗?选项部分加下划线？一头雾水……

能否做个实例放上来看看（上传附件）？

[此贴子已经被作者于2008-6-13 1:01:14编辑过]

sylun

QUOTE:

以下是引用tangqingfu在2008-6-13 0:57:01的发言：

To sylun兄:

不知在运行代码前该有哪些设置或操作?是将内容放在文本框中吗?选项部分加下划线？一头雾水……

能否做个实例放上来看看（上传附件）？

程序只认下划线，没有其他要求，一处连续的下划线依次编一个字母。原帖已附上我的测试文档。可试试随意调整段落行间距，字体大小，特殊换页等进行测试，不知其是否均适应。

[此贴子已经被作者于2008-6-13 1:30:35编辑过]

ynqjehlyx

打开word2007第一次按右键反应太慢