我有一张试卷附带有答案，如何才能用宏把答案填写到正确的位置呢？谢谢

cumulonimbus

我有一张试卷附带有答案，如何才能用宏把答案填写到正确的位置呢？答案在22页。

希望各路朋友能出手相助，八仙过海，各出奇招，想向各位学习一下。

hqswww

哇 楼主你可以去加入丐帮了~~{:soso_e120:}

cumulonimbus

一定有办法的，用宏，可是我功力有限，想不出来到底应该怎么写程序。{:soso_e109:}

sylun

试做了一下，有点复杂：

1. Sub test()
   
2.     Dim a() As String, i As Integer
   
3.     Dim aa() As String, c As Integer, n As Integer
   
4.     Dim TF As Boolean, s As Long
   
5.     Application.ScreenUpdating = False
   
6.     With ActiveDocument.Content.Find
   
7.         '搜集答案信息部分
   
8.         .Text = "填空题"
   
9.         .Forward = False
   
10.         .MatchWildcards = True
    
11.         If .Execute Then .Forward = True
    
12.         .Text = "^13[0-9]@．[!^13]{1,}"
    
13.         .Parent.Collapse wdCollapseEnd
    
14.         Do While .Execute
    
15.             ReDim Preserve a(i)
    
16.             a(i) = .Parent.Text
    
17.             a(i) = Trim(Mid(a(i), InStr(a(i), "．") + 1))
    
18.             i = i + 1
    
19.             If i > 60 Then Exit Do  '填空题共有61题
    
20.         Loop
    
21.         .Parent.Collapse wdCollapseEnd
    
22.         Do While .Execute("[0-9]@．[∨×]")
    
23.             ReDim Preserve a(i)
    
24.             a(i) = .Parent.Text
    
25.             a(i) = Trim(Mid(a(i), InStr(a(i), "．") + 1))
    
26.             i = i + 1
    
27.         Loop
    
28.         .Parent.Collapse wdCollapseEnd
    
29.         Do While .Execute("[0-9]@．[A-F]{1,}")
    
30.             ReDim Preserve a(i)
    
31.             a(i) = .Parent.Text
    
32.             a(i) = Trim(Mid(a(i), InStr(a(i), "．") + 1))
    
33.             i = i + 1
    
34.         Loop
    
35.         
    
36.        '定位填写答案部分
    
37.         .Parent.WholeStory
    
38.         i = 0
    
39.         .Text = ""
    
40.         .Font.Underline = wdUnderlineSingle
    
41.         .Format = True
    
42.         Do While .Execute
    
43.             If .Parent.Text <> Chr(13) Then
    
44.                 If TF = False Then
    
45.                     aa = Split(a(i), Chr(32))
    
46.                     TF = True
    
47.                 End If
    
48.                 For n = c To UBound(aa)
    
49.                     c = c + 1
    
50.                     If aa(n) <> Empty Then
    
51.                         .Parent.Text = Chr(32) & aa(n) & Chr(32)
    
52.                         If n = UBound(aa) Then
    
53.                             i = i + 1
    
54.                             c = 0
    
55.                             TF = False
    
56.                         End If
    
57.                         Exit For
    
58.                     End If
    
59.                 Next
    
60.             End If
    
61.             .Parent.Collapse wdCollapseEnd
    
62.         Loop
    
63.         .Format = False
    
64.         .Text = "（^32{4,}）"
    
65.         Do While .Execute
    
66.             With .Parent  '一道选择题如有两个以上括号，答案只在第一个括号内
    
67.                 If .Paragraphs.First.Range.Start > s Then
    
68.                     .SetRange .Start + 2, .End - 2
    
69.                     .Text = a(i)
    
70.                     s = .Paragraphs.First.Range.Start
    
71.                     i = i + 1
    
72.                 End If
    
73.                 .Collapse wdCollapseEnd
    
74.             End With
    
75.         Loop
    
76.     End With
    
77.     Application.ScreenUpdating = True
    
78. End Sub

复制代码

cumulonimbus

楼上的sylun辛苦了。这也能做出来，厉害哇!
可惜我道行尚浅，看不太懂word代码。
不过，我一定好好研究研究。
谢谢

chuhaiou

高手啊，收下了

cumulonimbus

我真丢人呀，看到这里，我就被卡住了。
请问sylun， .Text = "^13[0-9]@．[!^13]{1,}"这究竟是代表什么？如能指教，不胜感激

chuhaiou

我终于消化了这个代码了

tangqingfu

谢谢sylun兄的分享!
时间关系,没办法详细学习和消化代码.
请教如果答案已在题目中,如何将其提取出来放在题目后,即楼主附件的样式:题目与答案分离?

山山好又快

sylun 发表于 2011-10-21 17:46
试做了一下，有点复杂：

非常有效！收藏学习，不懂的到时请教。