根据excel中的文字用vba代码一键生有简单格式要求的word文档

excel中A列和B列中的数据如下图，数据从第一行开始的

把上图中B列内容整理成如下三个图所示格式的word文档

vba代码如下

Sub 根据excel中的文字用vba代码一键生有简单格式要求的word文档()

Dim a, b As Object '定义一个object型变量

Dim m, n, i As Long '定义3个long型整数变量

Set a = CreateObject('Word.Application') ' 调用word软件

a.Visible = True 'word软件前台可见

Set b = a.Documents.Add '创建一个空白word文档

Excel.Application.Sheets(1).Activate '从word切换到excel

m = Rows.Count '数一下 excel当前工作表共有多少行(空白行和非空白行都数)

n = Cells(m, 1).End(xlUp).Row '数一下 excel当前工作表共有多少行有内容

On Error Resume Next '程序执行遇到问题时候忽略问题继续执行后面代码

For i = 1 To n Step 1 '把excel中B列的内容拷贝粘贴到word中，按行拷贝粘贴，excel中B列一行占据word中一个段落

Excel.Application.ActiveSheet.Cells(i, 2).Copy '拷贝B列i行单元格的 内容

b.ActiveWindow.Selection.PasteAndFormat (wdFormatPlainText) '把B列i行单元格的内容粘贴到word中

Next i

For i = 1 To n Step 1 '在word中设置每一段落的格式

With b.Paragraphs(i)

If i = 1 Or i = 2 Or i = 3 Or i = 9 Or i = 14 Or i = 19 Or i = 23 Then '对于第1,2,3,9,14，19,23段落，格式如下

.Range.Font.Name = '微软雅黑' '第i个段落的字体是微软雅黑

.Range.Font.Size = 14 '第i个段落的字体大小是14

.Alignment = 1 '第i个段落的对齐方式是居中

.SpaceBefore = 20 '第i个段落与相邻的上一段落的段间距是20

.SpaceAfter = 20 '第i个段落与相邻的下一段落的段间距是20

.LineSpacingRule = wdLineSpaceAtLeast '第i个段落内部的行间距设置规则是wdLineSpaceAtLeast

.LineSpacing = 10 '第i个段落内部的行间距10

Else

.Range.Font.Name = '宋体' '第i个段落的字体是宋体

.Range.Font.Size = 8 '第i个段落的字体大小是8

.CharacterUnitFirstLineIndent = 2 '第i个段落的首行缩进2个字符

.SpaceBefore = 20 '第i个段落与相邻的上一段落的段间距是20

.SpaceAfter = 20 '第i个段落与相邻的的下一段落的段间距是20

.LineSpacingRule = wdLineSpaceAtLeast '第i个段落内部的行间距设置规则是wdLineSpaceAtLeast

.LineSpacing = 10 '第i个段落内部的行间距10

End If

End With

Next i

Set a = Nothing ' 释放内存

Set b = Nothing ' 释放内存

End Sub

'说明：本代码使用的几个前提：1）excel中数据格式需按照放置，否则得适应性修改代码 2） excel中B列的数据不能有空单元格，否则会产生错误 3）有时候第一遍运行代码不能产生你需要的结果，运行2到3遍甚至4遍即可,这是本代码的一个bug，待解决 4)本代码适合整理公众号文章：在excel中写出各段文字（1个段落占据1个单元格，比如B列一个 单元格），然后用代码一键整理成word文章