批量制作议题审批单

Sub 处理会议议程()Dim 领导议程数组 As Variant' 获取文档内容文档内容 = ActiveDocument.Content.Text' 创建正则表达式对象Set 正则表达式对象 = CreateObject("VBScript.RegExp")议程模式 = "[一二三四五六七八九十]+、[\s\S]*?会议议定：[\s\S]*?。"正则表达式对象.Pattern = 议程模式正则表达式对象.Global = True正则表达式对象.MultiLine = True' 执行匹配Set 匹配结果 = 正则表达式对象.Execute(文档内容)' 创建字典存储领导和对应的议题数组Set 领导字典 = CreateObject("Scripting.Dictionary")' 遍历匹配结果For Each 单个匹配 In 匹配结果议程文本 = 单个匹配.ValueMsgBox 议程文本领导姓名 = InputBox("上述议题由哪个领导分管？", "领导分管信息", "")If 领导字典.Exists(领导姓名) Then领导议程数组 = 领导字典(领导姓名)ReDim Preserve 领导议程数组(UBound(领导议程数组) + 1)领导议程数组(UBound(领导议程数组)) = 议程文本领导字典(领导姓名) = 领导议程数组ElseReDim 领导议程数组(0)领导议程数组(0) = 议程文本领导字典.Add 领导姓名, 领导议程数组End IfNext 单个匹配' 为每个领导创建一个文档并写入议题For Each 领导姓名 In 领导字典.KeysSet 新文档 = Documents.Add领导议程数组 = 领导字典(领导姓名)For i = LBound(领导议程数组) To UBound(领导议程数组)新文档.Content.InsertAfter 领导议程数组(i) & vbCrLf & vbCrLfNext i新文档.SaveAs2 FileName:=领导姓名 & ".docx"新文档.CloseNext 领导姓名
End Sub