最近帮我姐个忙,把excel中统计好的数据写到word中并设置成多级列表。
我没有学过vba,不太清楚怎么直接用vba设置多级列表。所以我用了一个取巧的方法。
我先根据下面两篇文章设置好了word多级列表的样式。
具体步骤就是先按照第一个链接设置多级列表,然后根据第二个链接的后半部分对样式进行下一步修改。
设置word多级列表样式
多级列表样式设置+样式的进一步修改
设置好之后就开始vba的部分了。新建一个宏:
//这里是在word中读取excel数据的部分,我是照着网上的教程写的,不知道为什么效果不太理想,忽略忽略,复制数据这一步可以手动实现
Set cnt = CreateObject("excel.application")
Set tb = cnt.workbooks.Open("C:\Users\freya\Desktop\周报\工作报告表-汇总.xlsm")
cnt.Visible = False
tb.worksheets("Sheet4").Cells(1, 1).Value.Copy
Selection.Paste
//在最后插入一个空行,这是因为我是通过下一行是空行判断这是二级列表的结尾
Set file = ActiveDocument
Set para = file.Paragraphs(file.Paragraphs.Count)
para.Range.InsertParagraphAfter
Dim num
num = 0
//遍历文件中的每一段
For Each para In file.Paragraphs
//前四行是模板的固定表头,所以不需要做任何处理
If num < 4 Then
num = num + 1
//匹配每一行的内容,设置不同的样式, Chr(13)代表空行
ElseIf para.Range.Text Like "*【本周工作】*" Then
para.Style = "小标题"
ElseIf para.Range.Text Like "*【下周计划】*" Then
para.Style = "小标题"
ElseIf para.Range.Text = Chr(13) Then
num = num
ElseIf para.Range.Text Like "*党委:*" Then
para.Style = "一级标题"
ElseIf para.Range.Text Like "*工会:*" Then
para.Style = "一级标题"
Else
para.Style = "二级标题"
//这里是因为excel中每一行的结尾都是句号,要求是每个二级列表的最后一行是句号,其他行是分号。我这里先统一改成分号
para.Range.Characters(para.Range.Characters.Count - 1) = ";"
End If
Next
//从文件的第一段遍历到倒数第二段,如果下一行是空行且本行的最后一个字符是‘;’,那么就改成‘。’
//这是为什么要在一开始添加一个空行,也是为什么只遍历到倒数第二段
For i = 1 To file.Paragraphs.Count - 1
Set para = file.Paragraphs(i)
If para.Next.Range.Text = Chr(13) Then
If para.Range.Characters(para.Range.Characters.Count - 1) = ";" Then
para.Range.Characters(para.Range.Characters.Count - 1) = "。"
End If
End If
Next
//另存为 & 不保存修改并关闭
ActiveDocument.SaveAs2 "C:\Users\freya\Desktop\周报\周报汇总.docx"
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
加注释加到一半才发现注释的格式不对,我还是不习惯vba的注释格式。如果有要使用代码的朋友记得修改。
最终实现的效果就是:
把数据从excel复制过来后:
代码处理后:
因为我姐这报告的结构是两个多级列表,通过上面的代码只能实现一个多级列表的排版。所以需要手动调整第二个多级列表中一级标题的编号。
先选中“三、党委:”这一行,点击一级标题那个样式,然后再回到那一行右键选择重新开始于一,这样第二个多级列表的一级标题编号就正常了。
网上关于vba实现多级列表的代码好少,如果有大神愿意指点一下就再好不过了