在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。

代码

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

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

设置选中表格行高

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

粗边框去侧边线

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

粗边框

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

用得比较多的一个整体的设置，一般设置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

分享个人收集或整理的word中常用的vba代码相关推荐

整理前端工作中的可复用代码（二）：拓展spark-md5，支持计算网络文件md5
这里是<整理前端开发中的可复用代码>中的第二篇,最初此系列文章的标题不是这个,但觉得标题要准确.明白一些,便做了修改.这里的经验都来自作者的工作实践,入了前端坑的摸爬滚打. 背景在工作中 ...
html网页中必填符号图片,收集的web页面html中常用的特殊符号大全
收集的web页面html中常用的特殊符号大全更新时间:2007年03月09日 00:00:00 作者: *特殊符号:·⊙①⊕◎Θ⊙*○¤㊣㈱@の*□*☆** ▲△▼▽⊿ ▂ ▃ ▄ ▆ * * ...
【整理】Word OpenXML常用标签
[整理]Word OpenXML常用标签一.背景最近在做关于Word内容自动标引,需要了解Word的底层结构,顺便梳理一下OpenXML的标签含义,方便后续开发,提高对OpenXML标签的查找效率 ...
如何在Word中排出漂亮的代码
引言学数学和计算机,当然还是用LaTeX排版技术文章更方便.但有时候还是迫不得已需要用Word写作,另外Word其实也有Word的好处,比如细节上的修改要比LaTeX方便. 从Matlab高亮代码复 ...
html页面中常用标记,收集的web页面html中常用的特殊符号大全
收集的web页面html中常用的特殊符号大全 2007-03-09 00:00:00 作者: 收集的web页面html中常用的特殊符号大全 *特殊符号:·⊙①⊕◎Θ⊙*○¤㊣㈱@の*□*☆** ▲△▼ ...
Word中常用快捷键Ctrl+字母的常快捷键
Word中常用快捷键Ctrl+ 建议收藏避免想用的时候找不到!!! Ctrl+字母的常用快捷键 [Ctrl + A]将所选内容扩展到包含整篇文档 [Ctrl + B]使字符变为粗体 [Ctrl + C ...
jsp/html开发中常用的JS代码和页面特效代码
1.jsp/html开发中常用的JS代码 1.后退前进 <input type="button" value="后退" onClick="hi ...
如何在Word中添加漂亮的代码块 | 很全的方法整理和比较
文章目录一.网上已有的方法二.推荐方法一.网上已有的方法网上已有的方法总结下来主要有以下几种: planetB | Syntax Highlight Code In Word Document ...
超实用Word技巧分享！这才是使用Word时常用到的高效率方法
使用Word这么久了,突然发现自己掌握了不少实用的技巧.这些技巧看似普通简单,但是在学习上还是工作上,都是经常使用的. 下面跟大家分享我在使用Word时,总结的一些技巧,希望对大家有帮助. 一.Wor ...

分享个人收集或整理的word中常用的vba代码