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

山山好又快

tangqingfu 发表于 2011-10-22 07:59
谢谢sylun兄的分享!
时间关系,没办法详细学习和消化代码.
请教如果答案已在题目中,如何将其提取出来放在题 ...

是啊，咱也有这个想法，能否赐教。谢谢！

chuhaiou

tangqingfu 发表于 2011-10-22 07:59
谢谢sylun兄的分享!
时间关系,没办法详细学习和消化代码.
请教如果答案已在题目中,如何将其提取出来放在题 ...

“题目与答案分离”比“把答案填写到正确的位置”更有实用价值。参考软件《化学金排》，它这两个功能都有。

tangqingfu

chuhaiou 发表于 2011-10-22 09:02
“题目与答案分离”比“把答案填写到正确的位置”更有实用价值。参考软件《化学金排》，它这两个功能都有 ...

谢谢chuhaiou兄!
主要是想学习一下处理方法,不知chuhaiou兄能否分享一下相关代码?

cumulonimbus

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

sylun辛苦了，在下还有事相求，不知可否回复。这里先行谢过。
请问， .Text = "^13[0-9]@．[!^13]{1,}"这究竟是代表什么？如能指教，不胜感激
还有，如果我想把选择题的正确答案变成红色醒目字体，要如何改呢？

lyb200

好，参考一下。。。。。。。。

sylun

cumulonimbus 发表于 2011-10-22 19:12
sylun辛苦了，在下还有事相求，不知可否回复。这里先行谢过。
请问， .Text = "^13[0-9]@．[!^13]{1,}"这 ...

请问， .Text = "^13[0-9]@．[!^13]{1,}"这究竟是代表什么？如能指教，不胜感激

这些查找代码文本其实就是查找替换高级用法中所涉及的字符代码及通配符，这是查找替换方面的知识，想具体了解，请查找一下word的帮助文件或在本版中搜索相关帖子。

还有，如果我想把选择题的正确答案变成红色醒目字体，要如何改呢？

前面代码修改为用红色并加粗字体标注答案：

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

复制代码

yjlexcelhome

向sylun 学习.

双飞叶

WORD  也得用得如此出神入化，真是佩服

sylun

抱歉，提取答案部分的代码试了几次也无法上传，提示有不良信息，只好慢慢试了，真是晕啊

sylun

先试代码的前半部分

1. Sub GetAnswer()
   
2.     Dim TF As Boolean, a As String, b As String, c As String, d As String
   
3.     Dim txt As String, i1 As Integer, i2 As Integer, i3 As Integer, i4 As Integer
   
4.     Dim n As Integer, s As Long, info As String
   
5.     Application.ScreenUpdating = False
   
6.     '提取答案内容
   
7.     If MsgBox("提取答案时是否同时删除试题中的答案文本？", vbYesNo) = vbYes Then TF = True
   
8.     With ActiveDocument.Content.Find
   
9.         .Font.Underline = wdUnderlineSingle
   
10.         .Format = True
    
11.         Do While .Execute
    
12.             With .Parent
    
13.                 If Val(.Paragraphs.First.Range.Text) > n Or Val(.Previous(wdParagraph).Text) > n Then
    
14.                     n = Val(IIf(Val(.Paragraphs.First.Range.Text) > n, .Paragraphs.First.Range.Text, .Previous(wdParagraph).Text))
    
15.                     If .Text <> Chr(13) Then a = a & vbCrLf & n & "．" & Trim(.Text)
    
16.                 ElseIf .Text <> Chr(13) Then
    
17.                     a = a & Space(4) & Trim(.Text)
    
18.                 End If
    
19.                 If TF = True And .Text Like "*[!" & Chr(13) & Chr(32) & "]*" Then .Text = Space(Len(.Text))
    
20.                 .Collapse wdCollapseEnd
    
21.             End With
    
22.         Loop
    
23.         .Parent.WholeStory
    
24.         .Format = False
    
25.         .Text = "（[^32∨×A-F]@）"
    
26.         .MatchWildcards = True
    
27.         Do While .Execute
    
28.             With .Parent  '一道选择题如有两个以上括号，答案只在第一个括号内
    
29.                 .SetRange .Start + 2, .End - 2
    
30.                 txt = Trim(.Text)
    
31.                 If .Paragraphs.First.Range.Start > s And Len(Trim(.Text)) > 0 Then
    
32.                     If txt Like "[∨×]" Then
    
33.                         i2 = i2 + 1
    
34.                         b = b & i2 & "．" & txt & IIf(i2 Mod 5 > 0, vbTab, vbCrLf)
    
35.                     ElseIf txt Like "[A-F]" Then
    
36.                         i3 = i3 + 1
    
37.                         c = c & i3 & "．" & txt & IIf(i3 Mod 5 > 0, vbTab, vbCrLf)
    
38.                     ElseIf Len(txt) > 1 Then
    
39.                         i4 = i4 + 1
    
40.                         d = d & i4 & "．" & txt & IIf(i4 Mod 5 > 0, vbTab, vbCrLf)
    
41.                     End If
    
42.                     If TF = True Then .Text = Space(IIf(Len(txt) = 1, 2, 6))
    
43.                 End If
    
44.                 s = .Paragraphs.First.Range.Start
    
45.                 .Collapse wdCollapseEnd
    
46.             End With
    
47.         Loop
    
48.     End With

复制代码