求批处理把1份复习题 自动生成试卷

sf2022

https://wwd.lanzouq.com/iCXQt049xfcj   所有文件在这里

目前有一份WORD复习题，想实现：
1、把生成一份测试试卷，把这份复习题中的每个红色字替换为4个“_”。
2、删除每题中的非红色字，仅保留红字，某题中如果有多组红字，则用一个全角空格隔开。前面的题号与第1步中对应不变。
3、将第2步中生成的内容追加到第1步的文件尾部，追加前插入“试题答案”字样，占一行。
PS：至此试卷部分题号是1-90题，答案部分题号也是1-90。
4、对项目编号进行文本化处理，即试卷和答案的题号都调整为普通文字。
Sub 项目编号文本化()
ActiveDocument.Content.ListFormat.ConvertNumbersToText
End Sub
  我用这个 但是之后会有一个“制表符”得替换删除，参考。
5、生成的文件名，和原文件名相同在后加“_试卷”。


就是把一份复习题，生成一份试卷，后面追加答案。

谢谢师兄，辛苦。

flashercs

Module1.bas
这是vba模块,导入就行

1. Attribute VB_Name = "Module1"
   
2. Sub NewExam2()
   
3. Attribute NewExam2.VB_Description = "生成试题和答案,在同一文档docx"
   
4. Attribute NewExam2.VB_ProcData.VB_Invoke_Func = "Normal.Module1.NewExam2"
   
5. ' 宏
   
6. ' 生成新试题和答案
   
7. '
   
8. On Error Resume Next
   
9. Const ExamName As String = "_试卷.docx"
   
10. 
    
11. Dim docSrc As Document, docExam As Document
    
12. Dim i As Long, oRange As range, oRange2 As range, itempara As Paragraph
    
13. Dim fso, examPath As String
    
14. Set fso = CreateObject("Scripting.FileSystemObject")
    
15. 
    
16. Set docSrc = ActiveDocument
    
17. If docSrc Is Nothing Then Exit Sub
    
18. examPath = fso.BuildPath(docSrc.Path, fso.GetBaseName(docSrc.Name) & ExamName)
    
19. If fso.FileExists(examPath) Then fso.DeleteFile examPath, True
    
20. If Err.Number <> 0 Then Exit Sub
    
21. docSrc.SaveAs2 examPath
    
22. Set docExam = ActiveDocument
    
23. 
    
24. Application.ScreenUpdating = False
    
25. 
    
26. docExam.ConvertNumbersToText
    
27. 
    
28. Set oRange = docExam.Content
    
29. oRange.SetRange oRange.Paragraphs(2).range.Start, oRange.End - 1
    
30. With oRange.Find
    
31.     .ClearFormatting
    
32.     .Text = "(^t{1,})"
    
33.     .MatchWildcards = True
    
34.     With .Replacement
    
35.         .ClearFormatting
    
36.         .Text = ""
    
37.     End With
    
38.     .Execute Replace:=wdReplaceAll
    
39. End With
    
40. oRange.Copy
    
41. 
    
42. Selection.EndKey wdStory
    
43. Selection.InsertNewPage
    
44. Selection.EndKey wdStory
    
45. Selection.InsertAfter "试题答案:"
    
46. Selection.InsertParagraphAfter
    
47. Selection.EndKey wdStory
    
48. Set oRange2 = Selection.range
    
49. oRange2.Paste
    
50. 
    
51. With oRange.Find
    
52.     .ClearFormatting
    
53.     .Font.ColorIndex = wdRed
    
54.     .Format = True
    
55.     .Text = "*"
    
56.     .MatchWildcards = True
    
57.     With .Replacement
    
58.         .ClearFormatting
    
59.         .Font.ColorIndex = wdAuto
    
60.         .Text = "____"
    
61.     End With
    
62.     .Execute Replace:=wdReplaceAll
    
63. End With
    
64. For Each itempara In oRange2.Paragraphs
    
65.     With itempara.range
    
66.         .MoveStartUntil "."
    
67.         .MoveStart wdCharacter, 1
    
68.         .MoveEnd wdCharacter, -1
    
69.         With .Find
    
70.             .ClearFormatting
    
71.             .Font.ColorIndex = wdAuto
    
72.             .Format = True
    
73.             .Text = "*"
    
74.             .MatchWildcards = True
    
75.             With .Replacement
    
76.                 .ClearFormatting
    
77.                 .Text = " "
    
78.             End With
    
79.             .Execute Replace:=wdReplaceAll
    
80.             .ClearFormatting
    
81.             .Format = False
    
82.             .Text = "( {1,})"
    
83.             .MatchWildcards = True
    
84.             With .Replacement
    
85.                 .Text = " "
    
86.             End With
    
87.             .Execute Replace:=wdReplaceAll
    
88.         End With
    
89.         .Font.ColorIndex = wdRed
    
90.         .Text = Trim$(.Text)
    
91.     End With
    
92. Next
    
93. docExam.Save
    
94. 'docExam.Close
    
95. Set fso = Nothing
    
96. Application.ScreenUpdating = True
    
97. MsgBox "生成试题和答案完成."
    
98. 
    
99. End Sub
    
100. 
     

复制代码

sf2022

回复 2# flashercs


    测试成功 感谢

sf2022

回复 2# flashercs

为什么生成的文件关闭后，就再也打不开了

能把代码改成VBS吗？或其他的，运行后 对当前目录下的所有WROD生效

谢谢

for_flr

请教大佬，如果用powershell，如何匹配到颜色字体

5i365

回复 2# flashercs


   感谢大侠分享, 要是能改成ps代码,就更好了, vba 看不懂