|
- Sub test2()
- Dim r%, i%
- Dim arr(), brr
- Dim mydoc As Document
- Dim flg(1 To 3) As Boolean
- Dim reg(1 To 4) As New RegExp
- With reg(1)
- .Global = False
- .Pattern = "^([一二三四五六七八九]、)(选择题|非选择题).*"
- End With
- With reg(2)
- .Global = False
- .Pattern = "^(\d+\.)"
- End With
- With reg(3)
- .Global = False
- .Pattern = "^【答案】(.*)"
- End With
- With reg(4)
- .Global = False
- .Pattern = "^(【详解】|【分析】).*"
- End With
- Set mydoc = Documents.Add
- With ThisDocument
- ReDim arr(1 To .Paragraphs.Count, 1 To 1)
- m = 0
- flg2 = False
- For i = 1 To .Paragraphs.Count
- ss = .Paragraphs(i).Range.Text
- If reg(1).test(ss) Then
- .Paragraphs(i).Range.Copy
- mydoc.Activate
- Selection.EndKey wdStory
- Selection.Paste
- flg(1) = True
- ElseIf reg(2).test(ss) Then
- If flg(1) = True Then
- n = InStr(ss, ".")
- .Range(Start:=.Paragraphs(i).Range.Start, End:=.Paragraphs(i).Range.Start + n).Copy
- mydoc.Activate
- Selection.EndKey wdStory
- Selection.Paste
- flg(2) = True
- End If
- ElseIf reg(3).test(ss) Then
- .Range(Start:=.Paragraphs(i).Range.Start + 4, End:=.Paragraphs(i).Range.End).Copy
- mydoc.Activate
- Selection.EndKey wdStory
- Selection.Paste
- flg(3) = True
- ElseIf reg(4).test(ss) Then
- flg(3) = False
- Else
- If flg(3) = True Then
- .Paragraphs(i).Range.Copy
- mydoc.Activate
- Selection.EndKey wdStory
- Selection.Paste
- End If
- End If
- Next
- End With
- With mydoc
- For i = 1 To .Paragraphs.Count
- With .Paragraphs(i).Range.ParagraphFormat
- .LeftIndent = CentimetersToPoints(0)
- .CharacterUnitFirstLineIndent = 2
- End With
- Next
- .SaveAs2 FileName:=ThisDocument.Path & "" & "答案"
- .Close False
- End With
- MsgBox "答案生成完毕,保存在当前文件夹下!"
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|