在word中通过VBA编写一些常用的函数，再利用快捷键激发，可以有效的提高写作的效率。以下分享个人通过网络收集，或者改造，或者自己录制后修改的代码，有需要的可以自取。
因为已经记不清有些代码的出处了，如果有使用到你的代码，烦请告之添加引用说明或者我删除掉，谢谢！

1.字体设置

作用

针对常用报告里英文采用Times New Roman字体，而全选文档设置后会导致引号变成难看的英文形式，故引号单独设置为宋体。

代码

Sub 设置字体()'数字、英文用Times,引号用宋体ActiveDocument.Content.Font.Name = "Times New Roman"Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWith Selection.Find.Text = "[" & ChrW(8220) & ChrW(8221) & "]".Replacement.Text = "".Forward = True.Wrap = wdFindContinue.Format = True.MatchCase = False.MatchWholeWord = False.MatchByte = False.MatchAllWordForms = False.MatchSoundsLike = False.MatchWildcards = True.Replacement.Font.Name = "宋体"End WithSelection.Find.Execute Replace:=wdReplaceAll
End Sub

2. 设置上下标

原因

对工科的报告来讲，经常报告里有需要设置上下标的地方，每次都要在报告里用鼠标（需要点N次），或者快捷键（不太方便按）的形式来设置，即不方便，还容易漏掉。

代码

Sub 设置上下标()Application.ScreenUpdating = False'    SetSuperscriptAndSubscript "×10", "8"'    SetSuperscriptAndSubscript "×10", "4"'单位'SetSuperscriptAndSubscript "km", "2"SetSuperscriptAndSubscript "m", "2"               '会同时处理m2,km2,m2/s等SetSuperscriptAndSubscript "m", "3"           '会同时处理m3,m3/s等'    SetSuperscriptAndSubscript "ｍ", "3"           '处理中文的m3'    SetSuperscriptAndSubscript "ｍ", "2"           '处理中文的m3'化学式'SO42-' SetSuperscriptAndSubscript "SO4", "2-"'SetSuperscriptAndSubscript "SO", "4", "2-", False' SO42-'HCO3-'SetSuperscriptAndSubscript "HCO3", "-"'  SetSuperscriptAndSubscript "HCO", "3", "-", False'H2S,h2sio4'  SetSuperscriptAndSubscript "H", "2", "S", False'SetSuperscriptAndSubscript "H2SIO", "4", "", False'O2,co2,NO2'   SetSuperscriptAndSubscript "O", "2", "", False'   SetSuperscriptAndSubscript "Fe", "2", "O", False'   SetSuperscriptAndSubscript "O", "3", "", False'   SetSuperscriptAndSubscript "P", "2", "O", False'   SetSuperscriptAndSubscript "O", "5", "", False'   SetSuperscriptAndSubscript "H", "2", "", False'N2'SetSuperscriptAndSubscript "N", "2", "", False'CH4,NH4'   SetSuperscriptAndSubscript "CH", "4", "", False'   SetSuperscriptAndSubscript "NH", "4", "", False'NH3-nSetSuperscriptAndSubscript "NH", "3", "-N", False'BOD5SetSuperscriptAndSubscript "BOD", "5", "", False'CODMN'  SetSuperscriptAndSubscript "COD", "Mn", "", False'  SetSuperscriptAndSubscript "COD", "Cr", "", False'Na+'  SetSuperscriptAndSubscript "Na", "+", ""'K+'  SetSuperscriptAndSubscript "K", "+", ""'Ca2+'  SetSuperscriptAndSubscript "Ca", "2+", ""'Mg2+'  SetSuperscriptAndSubscript "Mg", "2+", ""'H+'  SetSuperscriptAndSubscript "H", "+", ""'Cr6+'  SetSuperscriptAndSubscript "Cr", "6+", ""'  SetSuperscriptAndSubscript "S", "i", "", False'  SetSuperscriptAndSubscript "CaCO", "3", "", False'   SetSuperscriptAndSubscript "Al", "2", "O", FalseApplication.ScreenUpdating = True
End SubPrivate Sub SetSuperscriptAndSubscript(ByVal PrefixChr As String, ByVal SetChr As String, Optional ByVal PostChr As String, Optional ByVal SuperscriptMode As Boolean = True)'程序功能：设置文档中特定字符为上标或下标。'参数说明：'PrefixChr：必选参数，要设置为上、下标字符之前的字符；'SetChr：必选参数，要设置为上、下标的字符；'PostChr:必选,但可赋空字符串,若为了界定整个替换符号而包含的后缀,防止误替换,可加此参数'SuperscriptMode：可选参数，设置为 True 表示将 SetChr 设置为上标，设置为 False 表示将 SetChr 设置为下标，默认为 True。'举例说明：'我们要将文档中所有的“m3/s”中的“3”设置为上标，可通过下面这一行代码调用本程序完成：'SetSuperscriptAndSubscript "M","3" '这里设置上标，可省略第三个参数。Selection.Start = ActiveDocument.Paragraphs(1).Range.Start    '将光标定位至活动文档第一段落段首的位置Selection.Collapse wdCollapseStart                '折叠至起始位置With Selection.Find'先把整个字符换成上、下标.ClearFormatting.Replacement.ClearFormatting.Text = PrefixChr & SetChr & PostChr.Replacement.Text = .TextIf SuperscriptMode Then.Replacement.Font.Superscript = TrueElse.Replacement.Font.Subscript = TrueEnd If.Execute Replace:=wdReplaceAll'再把前面的内容换成原来正常的文本.ClearFormatting.Replacement.ClearFormatting.Text = PrefixChrIf SuperscriptMode Then.Font.Superscript = TrueElse.Font.Subscript = TrueEnd If.Replacement.Text = .TextIf SuperscriptMode Then.Replacement.Font.Superscript = FalseElse.Replacement.Font.Subscript = FalseEnd If.Execute Replace:=wdReplaceAll'再把后面的内容换成原来正常的文本If Len(PostChr) > 0 Then.ClearFormatting.Replacement.ClearFormatting.Text = PostChrIf SuperscriptMode Then.Font.Superscript = TrueElse.Font.Subscript = TrueEnd If.Replacement.Text = .TextIf SuperscriptMode Then.Replacement.Font.Superscript = FalseElse.Replacement.Font.Subscript = FalseEnd If.Execute Replace:=wdReplaceAllEnd IfEnd With
End Sub

PS:用到的SetSuperscriptAndSubscript函数好像是从网上找到的，具体作者忘记了，感谢！

3. 替换粘贴的内容

原因

经常从PDF文件或者网上复制的内容下来会有很多的空格，多余的回车，我个这个函数，配合alt+f快捷键，来快速的删除与替换相应的符号。主要包括空格、英文逗号、英文分号等。

代码

Sub 替换粘贴()'delete the spaceSelection.Find.Execute findtext:=" ", replacewith:="", Replace:=wdReplaceAll, Wrap:=wdFindStop'replace the english comma to chinese commaSelection.Find.Execute findtext:=",", replacewith:="，", Replace:=wdReplaceAll, Wrap:=wdFindStopSelection.Find.Execute findtext:=";", replacewith:="；", Replace:=wdReplaceAll, Wrap:=wdFindStopSelection.Find.Execute findtext:=":", replacewith:="：", Replace:=wdReplaceAll, Wrap:=wdFindStopSelection.Find.Execute findtext:="(", replacewith:="（", Replace:=wdReplaceAll, Wrap:=wdFindStopSelection.Find.Execute findtext:=")", replacewith:="）", Replace:=wdReplaceAll, Wrap:=wdFindStopSelection.Find.Execute findtext:="^p", replacewith:="", Replace:=wdReplaceAll, Wrap:=wdFindStop, MatchWildcards:=False
End Sub

4. 替换中文的单位

原因

有时候参考的老资料很多时候习惯用中文的单位，导致报告里的单位一会儿中文一会儿英文，为了统一，直接全部替换成英文的。
通过以下函数运行后，再运行上下标函数可实现上下标的修改。

代码

Sub 替换中文单位()Selection.Find.Execute findtext:="平方米", replacewith:="m2", Replace:=wdReplaceAll, Wrap:=wdFindStopSelection.Find.Execute findtext:="平方千米", replacewith:="km2", Replace:=wdReplaceAll, Wrap:=wdFindStopSelection.Find.Execute findtext:="平方公里", replacewith:="km2", Replace:=wdReplaceAll, Wrap:=wdFindStopSelection.Find.Execute findtext:="立方米", replacewith:="m3", Replace:=wdReplaceAll, Wrap:=wdFindStopSelection.Find.Execute findtext:="公里", replacewith:="km", Replace:=wdReplaceAll, Wrap:=wdFindStopSelection.Find.Execute findtext:="千米", replacewith:="km", Replace:=wdReplaceAll, Wrap:=wdFindStopSelection.Find.Execute findtext:="厘米", replacewith:="cm", Replace:=wdReplaceAll, Wrap:=wdFindStopSelection.Find.Execute findtext:="毫米", replacewith:="mm", Replace:=wdReplaceAll, Wrap:=wdFindStop
End Sub

5. 段落缩进处理

原因

很多人习惯用空格来代替段首的缩进，然后经常出现空格数量不是2个，导致格式不美。
我一般使用快捷键alt+s,s来设置缩进。针对有些表格里有乱七八糟的缩进，再用一个函数来取消缩进，设置快捷键alt+s,d

代码

Sub 缩进()With Selection.ParagraphFormat.CharacterUnitFirstLineIndent = 2.LeftIndent = 0End With
End Sub

Sub 缩进取消()With Selection.ParagraphFormat.CharacterUnitFirstLineIndent = 0.LeftIndent = 0.FirstLineIndent = CentimetersToPoints(0)End With
End Sub

6. 粘贴纯文本

原因

有时候复制别的文件里的内容，但只想要文字，不要格式。而用鼠标需要右键，选择纯文本粘贴，个人感觉太麻烦，换成快捷键：ctrl+shift+v

代码

Sub 粘贴保留文本()Selection.PasteAndFormat (wdFormatPlainText)
End Sub

7.设置打开文档的默认显示比例

原因

在现在的大显示屏下，word默认的100%的显示比例显然让文字太小了，一般现在都是放大后操作。个人的屏幕设置放大到130%合适，但每次都要去设置一遍就太麻烦了。利用代码设置每个文件打开后默认放大到130%。
每个文档打开后默认会运行AutoOpen函数，不要修改这个名字。自己的操作可以写到这里。

代码

Sub AutoOpen()'设置打开文档的默认显示比例ActiveDocument.ActiveWindow.View.Zoom.Percentage = 130'设置打开文档修改默认背景色背景色设置
End Sub

PS：以上代码中的背景色设置是我上一遍的设置word护眼绿色的函数。

8. 设置段落与下段同页

原因

用鼠标去操作这个太麻烦，要点N次才能找到，直接用快捷键代替，我是用的：ctrl+d

代码

Sub 与下段同页()Selection.Paragraphs.KeepWithNext = True
End Sub

9. 表格边框设置

原因

经常写报告的人可能会处理很多表格，常见的报告表格要嘛用粗边框，要嘛没有左右两侧的边框。为了不一个表格一个表格的去设置，采用代码控制，使用的时候只要鼠标点到表格内部任意位置，然后用快捷键设置格式。因为涉及多个函数，我用alt+b做引导，通过又快捷键控制，如设置表格重复标题行用alt+b,t。

代码

1. 重复标题行，选中要重复的标题行后按快捷键

Sub 表格重复标题行()Selection.Rows.HeadingFormat = wdToggle
End Sub

2. 设置选中表格行高

Sub 表格行高选中()Selection.Tables(1).Rows.HeightRule = wdRowHeightAtLeastSelection.Tables(1).Rows.Height = CentimetersToPoints(0.7)
End Sub

3. 粗边框去侧边线

Sub 表格粗边框去侧边线()Application.ScreenUpdating = FalseWith Selection.Tables(1)With .Borders(wdBorderVertical).LineStyle = wdLineStyleSingleEnd WithWith .Borders(wdBorderLeft).LineStyle = wdLineStyleNoneEnd WithWith .Borders(wdBorderRight).LineStyle = wdLineStyleNoneEnd WithWith .Borders(wdBorderTop).LineStyle = wdLineStyleSingle.LineWidth = wdLineWidth150ptEnd WithWith .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle.LineWidth = wdLineWidth150ptEnd WithEnd WithApplication.ScreenUpdating = True
End Sub

4. 粗边框

Sub 表格粗边框选中()Application.ScreenUpdating = FalseWith Selection.Tables(1)With .Borders(wdBorderLeft).LineStyle = wdLineStyleSingle.LineWidth = wdLineWidth150ptEnd WithWith .Borders(wdBorderRight).LineStyle = wdLineStyleSingle.LineWidth = wdLineWidth150ptEnd WithWith .Borders(wdBorderTop).LineStyle = wdLineStyleSingle.LineWidth = wdLineWidth150ptEnd WithWith .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle.LineWidth = wdLineWidth150ptEnd WithEnd WithApplication.ScreenUpdating = True
End Sub

5. 用得比较多的一个整体的设置，一般设置alt+b,g，一键完成表格格式设置

Sub 表格设置格式()Dim t As Table, s As RangeSet t = Selection.Tables(1)'Set s = t.Rows(1).Range'With s.Font'    .Bold = True        '表头加粗'End With'段落水平居中t.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter'段落垂直居中t.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter'设置字号t.Range.Font.Size = 10.5 '小5：9，5号：10.5，小四：12，四号：14,t.Range.Font.Name = "宋体"t.Range.Font.Name = "Times New Roman"'单倍行距t.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle'根据窗口自动调整表格t.AutoFitBehavior (wdAutoFitWindow)'根据内容自动调整表格t.AllowAutoFit = False表格行高选中'表格粗边框选中表格粗边框去侧边线缩进取消
End Sub

当然，也可以一键完成整个文档的设置的，给一个参考代码：

Sub 表格行高全文()Application.ScreenUpdating = FalseFor i = 1 To ActiveDocument.Tables.CountActiveDocument.Tables(i).Rows.HeightRule = wdRowHeightAtLeastActiveDocument.Tables(i).Rows.Height = CentimetersToPoints(0.7)NextApplication.ScreenUpdating = True
End Sub

10.设置图片大小

原因

如果文档中图片过多，一个一个去调整大小很麻烦。

代码

Sub 图片大小全文()Mywidth = 7                                     '10为图片宽度（厘米）Myheigth = 5.2                                      '5.2为图片高度（厘米）Application.ScreenUpdating = FalseFor Each ishape In ActiveDocument.InlineShapes    '嵌入型图片ishape.LockAspectRatio = msoFalse             '不锁定纵横比ishape.Height = 28.345 * Myheigth             '单位换算也可以用CentimetersToPoints()函数ishape.Width = 28.345 * MywidthNext ishapeApplication.ScreenUpdating = True
End Sub

PS:大小可以调整，这个参数合适双栏图片

给全文档的图片加一个边框：

Sub 图片边框全文()Dim oInlineShape As InlineShapeApplication.ScreenUpdating = FalseFor Each oInlineShape In ActiveDocument.InlineShapesWith oInlineShape.Borders.OutsideLineStyle = wdLineStyleSingle.OutsideColorIndex = wdColorAutomatic.OutsideLineWidth = wdLineWidth025ptEnd WithNextApplication.ScreenUpdating = True
End Sub

11.关于文档背景颜色的设置

原因

win10过后设置系统的护眼颜色在word里失效了，采用一个曲线办法：

代码

Sub 背景色设置()ActiveDocument.Background.Fill.Visible = msoTrueActiveDocument.Background.Fill.ForeColor.RGB = RGB(204, 232, 207)ActiveDocument.Background.Fill.SolidActiveDocument.ActiveWindow.View.DisplayBackgrounds = True
End SubSub 背景色取消()ActiveDocument.Background.Fill.Visible = msoFalse
End Sub