Word VBA排版参数案例
今日感受：
------------------------------------------------------------------------------------------------------------------------------------------------------------------
一、修改标题样式（1、2、3…级标题）
以1级标题为例，首先找到类型为“标题 1”的样式段落，再修改其具体样式，如加粗、下划线、倾斜、行距、段前段后等。实现代码如下：
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub FormatHeading2 () '修改1级标题 Dim p As Paragraph For Each p In ActiveDocument.Paragraphs If p.Style = ActiveDocument.styles("标题 1") Then p.Range.Font.Bold = True p.Range.Font.Italic = True ' 设置倾斜 p.Range .Font .Underline = wdUnderlineSingle '设置下划线（单下划线） p.Range.Font.Size = 15 p.Range.Font.name = "宋体" p.Range.ParagraphFormat.Alignment = wdAlignParagraphRight p.Range.ParagraphFormat.spaceBefore = 20 p.Range.ParagraphFormat.spaceAfter = 10 p.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle ' 单倍行距 p.Range .ParagraphFormat .CharacterUnitFirstLineIndent = 0 p.Range .ParagraphFormat .FirstLineIndent = CentimetersToPoints (0 ) End If Next p End Sub
其他更多详细的属性可自行查阅开发文档。
二、修改目录内容样式
对于目录中不同级别的标题的样式会存在差异，我查找并修改样式的过程是，先找到所有标题的名称，不同级别放入不同数组中，在每个数组遍历寻找第一次出现的段落修改其样式。注意注意：目录中的文本属于超链接文本！实现代码如下（以修改目录中1级标题为例）：
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 Sub updateDirectoryContentOneStyle () '注意超链接文本问题 Dim p As Paragraph Dim one() As String Dim oneCount As Integer Dim i As Integer For Each p In ActiveDocument.Paragraphs If p.Style = ActiveDocument.styles("标题 1") Then ReDim Preserve one(oneCount) ' 扩展一级标题数组 one (oneCount) = p.Range .text oneCount = oneCount + 1 End If Next p '输出数组中保存的标题内容 For i = 0 To UBound(one) Dim myRange As Range Dim myStyle As Style Set myRange = ActiveDocument.Content myRange.Find.Execute FindText:=one(i), Forward:=True ' 查找 If myRange.Find .Found = True Then With myRange .Font .Bold = False .Font .name = "宋体" .Font .Size = 14 End With End If Next End Sub
三、查找特定文本并修改其样式
本文以查找“关键词”三字为例。使用Find关键字进行查找，找到后修改其样式即可。更多的详细属性请参考开发文档，实现代码如下：
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub findText () Set myRange = ActiveDocument .Content myRange.Find .Execute FindText :="关键词" , Forward :=True If myRange.Find .Found = True Then With myRange .Font .Bold = False .ParagraphFormat .Alignment = wdAlignParagraphLeft '左对齐 .Font.Color = wdColorBlack .Font.name = "黑体" .Font.Size = 14 .ParagraphFormat.PageBreakBefore = False .ParagraphFormat.CharacterUnitFirstLineIndent = 0 ' 去除首行缩进 .ParagraphFormat .FirstLineIndent = CentimetersToPoints (0 ) End With End If End Sub
四、表格样式
修改表格样式，可以查阅开发文档与网络资源。我也参考了AI的一些代码。实现代码如下（最基本的不加样式的表格）：
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 Sub execlOperate() '表格样式操作 Application.ScreenUpdating = False '关闭屏幕刷新 Application.DisplayAlerts = False On Error Resume Next '忽略错误 Dim mytable As Table, i As Long If Selection.Information(wdWithInTable) = True Then i = 1 For Each mytable In ActiveDocument.Tables If i = 1 Then Set mytable = Selection.Tables(1) With mytable '取消底色 .Shading.ForegroundPatternColor = wdColorAutomatic .Shading.BackgroundPatternColor = wdColorAutomatic Options.DefaultHighlightColorIndex = wdNoHighlight .Range.HighlightColorIndex = wdNoHighlight .Style = "表格主题" '单元格边距 .TopPadding = PixelsToPoints(0, True) '设置上边距为0 .BottomPadding = PixelsToPoints(0, True) '设置下边距为0 .LeftPadding = PixelsToPoints(0, True) '设置左边距为0 .RightPadding = PixelsToPoints(0, True) '设置右边距为0 .Spacing = PixelsToPoints(0, True) '允许单元格间距为0 .AllowPageBreaks = True '允许断页 '.AllowAutoFit = True '允许自动调整尺寸 '设置边框 .Borders(wdBorderLeft).LineStyle = wdLineStyleNone .Borders(wdBorderRight).LineStyle = wdLineStyleNone .Borders(wdBorderTop).LineStyle = wdLineStyleNone .Borders(wdBorderBottom).LineStyle = wdLineStyleNone .Borders(wdBorderTop).LineStyle = wdLineStyleThinThickMedGap .Borders(wdBorderTop).LineWidth = wdLineWidth2pt .Borders(wdBorderBottom).LineStyle = wdLineStyleThickThinMedGap .Borders(wdBorderBottom).LineWidth = wdLineWidth225pt With .Rows .WrapAroundText = False '取消文字环绕 .Alignment = wdAlignRowCenter '表水平居中 wdAlignRowLeft '左对齐 .AllowBreakAcrossPages = False '不允许行断页 .HeightRule = wdRowHeightExactly '行高设为最小值 wdRowHeightAuto '行高设为自动 .Height = CentimetersToPoints(0) '上面缩进量为0 .LeftIndent = CentimetersToPoints(0) '左面缩进量为0 End With With .Range With .Font '字体格式 .name = "宋体" .name = "Times New Roman" .Color = wdColorAutomatic '自动字体颜色 .Size = 12 .Kerning = 0 .DisableCharacterSpaceGrid = True End With With .ParagraphFormat '段落格式 .CharacterUnitFirstLineIndent = 0 '取消首行缩进 .FirstLineIndent = CentimetersToPoints(0) '取消首行缩进 .LineSpacingRule = wdLineSpaceSingle '单倍行距 wdLineSpaceExactly '行距固定值 '.LineSpacing = 20 '设置行间距为20磅，配合行距固定值 .Alignment = wdAlignParagraphCenter '单元格水平居中 .AutoAdjustRightIndent = False .DisableLineHeightGrid = True End With .Cells.VerticalAlignment = wdCellAlignVerticalCenter '单元格垂直居中 End With '设置首行格式 .Cell(1, 1).Select ' 选中第一个单元格 With Selection .SelectRow '选中当前行 Selection.Rows.HeadingFormat = wdToggle '自动标题行重复 .Range.Font.Bold = False '表头加粗黑体 .Shading.ForegroundPatternColor = wdColorAutomatic '首行自动颜色 '.Shading.BackgroundPatternColor = -603923969 '首行底纹填充 End With '自动调整表格 .Columns.PreferredWidthType = wdPreferredWidthAuto .AutoFitBehavior (wdAutoFitContent) '根据内容调整表格 .AutoFitBehavior (wdAutoFitWindow) '根据窗口调整表格 End With If i = 1 Then Exit For Next Err.Clear: On Error GoTo 0 '恢复错误捕捉 Application.DisplayAlerts = True '开启提示 Application.ScreenUpdating = True '开启屏幕刷新 End Sub
————————————————
