vb设置excel 字体 加粗 微软雅黑_从excel拷贝文字粘贴到word并进行排版，主要是设置标题的多级列表...

Excel中A列和B列的内容如下：

最终生成的word文档如下三图所示：

Word中使用的vba代码如下：

Sub 从excel拷贝数据并粘贴到word并判断每一段落的标题级别n() '主程序，此代码放在word 中

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

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

Set a = CreateObject("Excel.Application") ' 调用excel软件

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

a.WorkBooks.Open FileName:="C:\Users\p503406\Desktop\根据excel中的文字一键生成满足格式要求的word文档(未完成).xlsx" '打开excel文件《根据excel中的文字一键生成满足格式要求的word文档(未完成).xls》

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

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

For i = 1 To n Step 1

a.ActiveSheet.Cells(i, 2).Copy '复制excel表格中i行2列单元格中的内容

Word.Application.Activate '激活word软件

Word.Application.Selection.PasteAndFormat (wdFormatPlainText) '把excel表格中i行2列单元格中的内容以纯文本格式粘贴到word文档中，每一个单元格中的内容在word中变成一个段落

With Word.Application.ActiveDocument.Paragraphs(i) '对于word中第i个段落(也即xcel表格中i行2列单元格中的内容)

If i <= 3 Then '对于word中的前3个段落

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

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

.Range.Font.Bold = True '字体加粗

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

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

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

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

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

ElseIf i > 3 Then '对于第4及以后的段落

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

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

.Range.Font.Bold = False '字体不加粗

.Alignment = 0 '第i个段落的对齐方式是左对齐

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

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

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

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

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

End If

End With

If a.ActiveSheet.Cells(i, 1).Value = "正文一级标题" Then '对于一级标题的段落

Call 可为文章任何一个段落添加多级列表 '调用名为“可为文章任何一个段落添加多级列表”代码为此标题增加一级列表符号

Word.Application.ActiveDocument.Paragraphs(i).Range.Font.Bold = True '一级标题字体加粗

ElseIf a.ActiveSheet.Cells(i, 1).Value = "正文二级标题" Then

Call 可为文章任何一个段落添加多级列表 '调用名为“可为文章任何一个段落添加多级列表”代码为此标题增加一级列表符号

Selection.Range.ListFormat.ListIndent '将一级列表符号降低一级，变为二级列表符号

Word.Application.ActiveDocument.Paragraphs(i).Range.Font.Bold = True '二级标题字体加粗

ElseIf a.ActiveSheet.Cells(i, 1).Value = "正文三级标题" Then

Call 可为文章任何一个段落添加多级列表 ''调用名为“可为文章任何一个段落添加多级列表”代码为此标题增加一级列表符号

Selection.Range.ListFormat.ListIndent '将一级列表符号降低一级，变为二级列表符号

Selection.Range.ListFormat.ListIndent '将二级列表符号降低一级，变为三级列表符号

Word.Application.ActiveDocument.Paragraphs(i).Range.Font.Bold = True '三级标题字体加粗

End If

Selection.TypeParagraph '在word中第i个段落末尾换行

Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph '换行后产生的新段落前自动添加多级列表符号，将多级列表符号删除，为插入第i+1个段落或标题做准备

Next i

Set a = Nothing ' 释放内存

End Sub

Sub 可为文章任何一个段落添加多级列表() '被主程序调用的程序，此代码放在word 中

With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(1)

.NumberFormat = "%1."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(0.75)

.TabPosition = wdUndefined

.ResetOnHigher = 0

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(2)

.NumberFormat = "%1.%2."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(1)

.TabPosition = wdUndefined

.ResetOnHigher = 1

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(3)

.NumberFormat = "%1.%2.%3."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(1.25)

.TabPosition = wdUndefined

.ResetOnHigher = 2

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(4)

.NumberFormat = "%1.%2.%3.%4."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(1.5)

.TabPosition = wdUndefined

.ResetOnHigher = 3

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(5)

.NumberFormat = "%1.%2.%3.%4.%5."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(1.75)

.TabPosition = wdUndefined

.ResetOnHigher = 4

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(6)

.NumberFormat = "%1.%2.%3.%4.%5.%6."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(2)

.TabPosition = wdUndefined

.ResetOnHigher = 5

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(7)

.NumberFormat = "%1.%2.%3.%4.%5.%6.%7."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(2.25)

.TabPosition = wdUndefined

.ResetOnHigher = 6

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(8)

.NumberFormat = "%1.%2.%3.%4.%5.%6.%7.%8."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(2.5)

.TabPosition = wdUndefined

.ResetOnHigher = 7

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(9)

.NumberFormat = "%1.%2.%3.%4.%5.%6.%7.%8.%9."

.TrailingCharacter = wdTrailingTab

.NumberStyle = wdListNumberStyleArabic

.NumberPosition = CentimetersToPoints(0)

.Alignment = wdListLevelAlignLeft

.TextPosition = CentimetersToPoints(2.75)

.TabPosition = wdUndefined

.ResetOnHigher = 8

.StartAt = 1

With .Font

.Bold = True

.Italic = wdUndefined

.StrikeThrough = wdUndefined

.Subscript = wdUndefined

.Superscript = wdUndefined

.Shadow = wdUndefined

.Outline = wdUndefined

.Emboss = wdUndefined

.Engrave = wdUndefined

.AllCaps = wdUndefined

.Hidden = wdUndefined

.Underline = wdUndefined

.Color = wdUndefined

.Size = wdUndefined

.Animation = wdUndefined

.DoubleStrikeThrough = wdUndefined

.Name = ""

End With

.LinkedStyle = ""

End With

ListGalleries(wdOutlineNumberGallery).ListTemplates(1).Name = ""

Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _

ListGalleries(wdOutlineNumberGallery).ListTemplates(1), _

ContinuePreviousList:=True, ApplyTo:=wdListApplyToWholeList, _

DefaultListBehavior:=wdWord10ListBehavior

End Sub

'说明：上述两段代码使用的几个前提：1)excel中B列的数据最好不要有空单元格，否则会产生错误 3)有时候第一遍运行代码不能产生你需要的结果，运行2到3遍甚至4遍即可,这是本代码的一个bug，待解决

以上两段代码运用到一些基本代码

'Sub 从excel引入文章所需各段文字内容并对内容进行排版() '设置字体+添加多级列表

'' Selection.TypeParagraph'在光标处换行

' Selection.PasteAndFormat (wdFormatPlainText) '将剪贴板的内容拷贝到word文档，在光标处粘贴

' Call 可为文章任何一个段落添加多级列表

' Selection.TypeParagraph

' Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph

' '思路：从excel一行一行拷贝数据粘贴到word中，每拷贝一行粘贴后，立即清除其多级列表格式，然后进行判断，如果是一级标题，直接增加多级标题(默认的是增加一级标题)，如果是二级标题，先增加多级标题，再缩进一次，如果是三级标题，先增加多级标题，再缩进2次，一次类推，直到第9级

'End Sub

'

'Sub 把一个段落的列表级别降低一级() '比如1变成1.1，比如1.1变成1.1.1

' Selection.Range.ListFormat.ListIndent

'End Sub

'

'

'Sub 把一个段落的列表级别提升一级() '比如1.1变成1，比如1.1.1变成1.1

' Selection.Range.ListFormat.ListOutdent

'End Sub

'

'

'Sub 把一个段落最前面的级别列表数字删除() '比如把"1.1 概述"变成“概述”，前面的1.1删除了

' Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph

'End Sub

'

'

'Sub 想把一个段落设置成几级标题就几级标题的代码()

' Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph '先假设段落粘贴后自动产生了多级列表序号，然后利用此行代码删除该段落的多级列表序号

'

' Call 可为文章任何一个段落添加多级列表 '再为段落增加多级列表序号，无法判断系统给此段落增加的是几级列表序号，有可能是1，也有可能是1.1，也有可能是1.1.1

' For i = 1 To 9 Step 1 '利用for...next循环统一把该段落的列表序号变成一级序号，比如1或2或3

' Selection.Range.ListFormat.ListOutdent '列表序号提升一级

' Next i

'

' If n > 1 Then

' For i = 1 To n - 1 Step 1 '利用for...next 循环降低该段落多级列表序号的级别，变成自己需要的级别。n指的是当前段落想要的级别，比如n=2

' Selection.Range.ListFormat.ListIndent ' 列表序号降低一级

' Next i

' End If

'

'End Sub