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

sylun · 发表于 2011-10-23 18:58

以下代码兼顾填写和提取答案两项功能，是根据文档是第一个下划线格式文本是否为空格来智能判断的。处理时只需运行Main过程。当然，代码只是基于原附件文档，并没有普遍适用性，仅共参考。

Sub Main()
'以文档第一个下划线格式文本是否为空格来判断提取
With ActiveDocument.Content.Find
.Font.Underline = wdUnderlineSingle
.Format = True
If .Execute Then If Trim(.Parent.Text) = Empty Then InsertAnswer Else GetAnswer
End With
End Sub
Sub InsertAnswer()
Dim a() As String, i As Integer
Dim aa() As String, c As Integer, n As Integer
Dim TF As Boolean, s As Long
Dim myRange As Range
Application.ScreenUpdating = False
With ActiveDocument.Content.Find
'搜集答案信息部分
.Text = "填空题"
.Forward = False
.MatchWildcards = True
If .Execute Then .Forward = True
.Text = "^13[0-9]@．[!^13]{1,}"
.Parent.Collapse wdCollapseEnd
Do While .Execute
ReDim Preserve a(i)
a(i) = .Parent.Text
a(i) = Trim(Mid(a(i), InStr(a(i), "．") + 1))
i = i + 1
If i > 60 Then Exit Do '填空题共有61题
Loop
.Parent.Collapse wdCollapseEnd
Do While .Execute("[0-9]@．[∨×]")
ReDim Preserve a(i)
a(i) = .Parent.Text
a(i) = Trim(Mid(a(i), InStr(a(i), "．") + 1))
i = i + 1
Loop
.Parent.Collapse wdCollapseEnd
Do While .Execute("[0-9]@．[A-F]{1,}")
ReDim Preserve a(i)
a(i) = .Parent.Text
a(i) = Trim(Mid(a(i), InStr(a(i), "．") + 1))
i = i + 1
Loop
'定位填写答案部分
.Parent.WholeStory
i = 0
.Text = ""
.Font.Underline = wdUnderlineSingle
.Format = True
Do While .Execute
If .Parent.Text <> Chr(13) Then
If TF = False Then
aa = Split(a(i), Chr(32))
TF = True
End If
For n = c To UBound(aa)
c = c + 1
If aa(n) <> Empty Then
With .Parent
.Text = Chr(32) & aa(n) & Chr(32)
.Font.Color = wdColorRed
.Bold = True
End With
If n = UBound(aa) Then
i = i + 1
c = 0
TF = False
End If
Exit For
End If
Next
End If
.Parent.Collapse wdCollapseEnd
Loop
.Format = False
.Text = "（^32{4,}）"
Do While .Execute
With .Parent '一道选择题如有两个以上括号，答案只在第一个括号内
If .Paragraphs.First.Range.Start > s Then
.SetRange .Start + 2, .End - 2
.Text = a(i)
If a(i) Like "*[!A-F]*" = False Then
Set myRange = .Duplicate
myRange.Collapse wdCollapseEnd
With myRange.Find
.MatchWildcards = True
.Replacement.Font.Bold = True
.Replacement.Font.Color = wdColorRed
For c = 1 To Len(a(i))
.Text = Mid(a(i), c, 1) & "[．.]*^13"
.Execute Replace:=wdReplaceOne
.Parent.Collapse wdCollapseEnd
Next
End With
End If
s = .Paragraphs.First.Range.Start
i = i + 1
End If
.Collapse wdCollapseEnd
End With
Loop
End With
Application.ScreenUpdating = True
End Sub

复制代码

sylun · 发表于 2011-10-23 19:54

本帖最后由 sylun 于 2011-10-23 20:08 编辑

再试后半部分：

'在文档末尾写入答案文本并设置基本格式
info = "参·考·答·案" & vbCrLf & "一、填空题" & a & vbCrLf & "二、判断题" & vbCrLf & b _
& vbCrLf & "三、单项选择" & vbCrLf & c & vbCrLf & "四、多项选择" & vbCrLf & d
With ActiveDocument.Content
If TF = True Then
With .Find
.Font.Color = wdColorRed
.Font.Bold = True
.Replacement.Font.Color = wdColorAutomatic
.Replacement.Font.Bold = False
.Execute Replace:=wdReplaceAll
End With
End If
.InsertAfter vbCrLf
With .Paragraphs.Last.Range
.Font.Size = 12
With .ParagraphFormat
.CharacterUnitFirstLineIndent = 0
.CharacterUnitLeftIndent = 0
.FirstLineIndent = 0
.LeftIndent = 0
.TabStops.ClearAll
For n = 1 To 4
.TabStops.Add n * 75
Next
End With
.InsertAfter info
With .Paragraphs.First
.Alignment = wdAlignParagraphCenter
.OutlineLevel = wdOutlineLevel1
.PageBreakBefore = True
With .Range.Font
.Grow
.Grow
.Bold = True
End With
End With
With .Find
.Execute "^9^p", replacewith:="^p", Replace:=wdReplaceAll
.MatchWildcards = True
.Text = "[一二三四]、*^13"
Do While .Execute
With .Parent
.Font.Name = "黑体"
.ParagraphFormat.OutlineLevel = wdOutlineLevel2
.Collapse wdCollapseEnd
End With
Loop
End With
End With
End With
Application.ScreenUpdating = True
End Sub

复制代码

原来是“参考”与“答案”合在一起作的怪。

ammyc · 发表于 2011-10-23 20:20

收藏学习。

zhgj007 · 发表于 2011-10-23 22:15

非常感谢sylun ，真的太棒了。我试了试我的文件，不论是添加还是提取都不成功，您能否帮忙看看？

金华秀儿 · 发表于 2011-10-24 00:36

高手啊，佩服了

zhgj007 · 发表于 2011-10-24 20:33

本帖最后由 zhgj007 于 2011-10-24 20:37 编辑

非常感谢sylun兄，真的太棒了。我试了试我的文件，不论是添加还是提取都不成功，并且总有一处出错，您能否帮忙看看？

cumulonimbus · 发表于 2011-10-24 21:02

sylun 发表于 2011-10-23 19:54
再试后半部分：原来是“参考”与“答案”合在一起作的怪。

.Text = "^13[0-9]@．[!^13]{1,}"
不好意思，再次求教SYLUN大哥，这上面字符中间的点是啥意思？找了半天也没找到“．”这个代表什么意思。能否解释一下哈。谢谢

tangqingfu · 发表于 2011-10-24 21:15

本帖最后由 tangqingfu 于 2011-10-25 08:09 编辑

所有以段落标记开始，然后是数字编号（加点号），后面是以非段落标记的内容。
“．”这个就是数字编号后面的点而已

cumulonimbus · 发表于 2011-10-24 21:36

本帖最后由 cumulonimbus 于 2011-10-24 21:37 编辑

tangqingfu 发表于 2011-10-24 21:15
所有以非段落标记开始，然后是数字编号（加点号），后面是以非段落标记的内容。
“．”这个就是数字编号后 ...

非常感谢你的热心回答。
我有点明白了。

kqbt · 发表于 2011-10-24 23:54

tangqingfu 发表于 2011-10-24 21:15
所有以非段落标记开始，然后是数字编号（加点号），后面是以非段落标记的内容。
“．”这个就是数字编号后 ...

“所有以非段落标记开始”
tang兄，这里应是“以段落标记开始”吧？

		自动登录	找回密码
密码			免费注册

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

评分

为什么不论是添加还是提取都不成功，并且总有一处出错