Word宏代码集锦

目录修改word格式1 智能清除选区软回车（换行符）12 清除选区多余空段13 合并选区中“，”结束的多余分段34 清除选区单字节空格35 清除选区单字节空格36 清除选区1字空格47 清除选区段首2字空格48 清除选区Tab49 增加选区空格510 选区段首缩进0字511 选区段首缩进:2字512 选区段首缩进转空格已完美613 选区段后间距1行614 选区段后间距1行615 选区段后间距1行716 清除选区图片717 选区硬回车转软回车718 清除选区软回车719 合并选区段落820 选区空格转硬回车821 选区标点半角转全角822 选区标点全角转半角1023 选区中文句号转半角1124 把文档第一段设置为标题1的格式1125 选中的文本横向居中1126 缩小字距1227 增大字距1228 缩小行距1329 增大行距1330 等高变宽1431 等高变窄1432 字表间距1433 纵向16开1534 插入页码1535 小写金额转大写金额1636 去掉空白行1737 查找替换1838 总结：word自动化排版宏18其它1 调整图片大小222 转字体223 转文件格式234 文件加密245 字符替换246 替换引号247 打印为PDF格式文件258 朗读文本269 文献标号上标化2610 箭头上方加文字2711 添加参考文献格式一，参考文献在文档末尾以1 2 3 格式排列2712 添加参考文献格式二，参考文献在文档末尾以1 2 3 格式排列，修改自格式一的代码2813 返回正文2814 再次引用已有参考文献2915 查找被删参考文献遗留引用，2916 统计修订的字数2917 快速提取脚注内容3018 从任意页面编排页码3120 对文档内容进行顺序排列3221 替换Word文档插图的超链接3222 为文档的每页添加固定内容3223 批量实现图片的等比例缩3324 提取域代码3325 完美显示图片表格的普通视图3426 完美显示图片表格的页面视图3427 彻底删除页眉页脚3528 切换纵横向页面3536Word宏代码集锦修改word格式1 智能清除选区软回车（换行符）Sub 智能清除选区软回车() With Selection.Find .Text = ?l .Replacement.Text = &p .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = 1l .Replacement.Text = &p End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = l .Replacement.Text = End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub2 清除选区多余空段Sub 清除选区多余空段() With Selection.Find .Text = pp .Replacement.Text = p .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = ppp .Replacement.Text = p .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = ppp .Replacement.Text = p .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = pp .Replacement.Text = p .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = pp .Replacement.Text = p .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = ppp .Replacement.Text = p .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = p .Replacement.Text = p .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = pp .Replacement.Text = p .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = pp .Replacement.Text = p .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub3 合并选区中“，”结束的多余分段Sub 合并选区多余分段() With Selection.Find .Text = ，p .Replacement.Text = ， .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = 、p .Replacement.Text = 、 .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub4 清除选区单字节空格Sub 清除选区单字节空格() With Selection.Find .Text = .Replacement.Text = .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub5 清除选区单字节空格Sub 清除选区2单字节空格() With Selection.Find .Text = .Replacement.Text = .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub6 清除选区1字空格Sub 清除选区1字空格() With Selection.Find .Text = .Replacement.Text = .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub7 清除选区段首2字空格Sub 清除选区段首2字空格() With Selection.Find .Text = .Replacement.Text = .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub8 清除选区TabSub 清除选区Tab() With Selection.Find .Text = vbTab .Replacement.Text = .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub9 增加选区空格Sub 增加选区空格() With Selection.Find .Text = .Replacement.Text = .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub10 选区段首缩进0字Sub 选区段首无缩进()With Selection.Find .Text = .Replacement.Text = .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.ParagraphFormat .LeftIndent = CentimetersToPoints(0) 左缩进0字符 .RightIndent = CentimetersToPoints(0) 右缩进0字符 .FirstLineIndent = CentimetersToPoints(0) 首行缩进点0公分 .CharacterUnitLeftIndent = 0 左缩进单位0字符 .CharacterUnitRightIndent = 0 右缩进单位0字符 .CharacterUnitFirstLineIndent = 0 End With With Selection.ParagraphFormat .LeftIndent = CentimetersToPoints(0) 左缩进1字符 .RightIndent = CentimetersToPoints(0) 右缩进2字符 .FirstLineIndent = CentimetersToPoints(0) 首行缩进点0.35公分 .CharacterUnitLeftIndent = 0 左缩进单位0字符 .CharacterUnitRightIndent = 0 右缩进单位0字符 .CharacterUnitFirstLineIndent = 0 End WithEnd Sub11 选区段首缩进:2字Sub 选区段首缩进2字() With Selection.ParagraphFormat .LeftIndent = CentimetersToPoints(0) 左缩进1字符 .RightIndent = CentimetersToPoints(0) 右缩进2字符 .FirstLineIndent = CentimetersToPoints(0.35) 首行缩进点单位公分 .CharacterUnitLeftIndent = 0 左缩进单位0字符 .CharacterUnitRightIndent = 0 右缩进单位0字符 .CharacterUnitFirstLineIndent = 2 End WithEnd Sub12 选区段首缩进转空格已完美Sub 选区段首缩进转空格() Selection.InsertParagraphBefore Call 选区段首无缩进 With Selection.Find .Text = p .Replacement.Text = p .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Delete With Selection.Find .Text = p .Replacement.Text = .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub13 选区段后间距1行Sub 选区段后间距1行() Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0) Selection.ParagraphFormat.LineUnitAfter = 1End Sub14 选区段后间距1行 Sub 选区段前段后间距半行() Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0) Selection.ParagraphFormat.LineUnitBefore = 0.5 Selection.ParagraphFormat.LineUnitAfter = 0.5End Sub15 选区段后间距1行Sub 选区段前段后无间距() Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0) Selection.ParagraphFormat.LineUnitBefore = 0 Selection.ParagraphFormat.LineUnitAfter = 0End Sub16 清除选区图片Sub 清除选区图片() With Selection.Find .Text = 1 .Replacement.Text = .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub17 选区硬回车转软回车Sub 选区硬回车转软回车() With Selection.Find .Text = p .Replacement.Text = l .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub18 清除选区软回车Sub 清除选区软回车() With Selection.Find .Text = l .Replacement.Text = .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub19 合并选区段落Sub 合并选区段落() With Selection.Find .Text = .Replacement.Text = .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = p .Replacement.Text = l .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = l .Replacement.Text = .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll Selection.Paragraphs.Add 添加段落符号End Sub20 选区空格转硬回车Sub 选区空格转硬回车() With Selection.Find .Text = .Replacement.Text = p .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub21 选区标点半角转全角Sub 选区标点半角转全角() With Selection.Find .Text = , .Replacement.Text = ， .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = ; .Replacement.Text = ； .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = : .Replacement.Text = ： .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = ? .Replacement.Text = ？ .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = ! .Replacement.Text = ！ .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = . .Replacement.Text = .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = . .Replacement.Text = 。 .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub22 选区标点全角转半角Sub 选区标点全角转半角() With Selection.Find .Text = ， .Replacement.Text = , .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = ； .Replacement.Text = ; .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = ： .Replacement.Text = : .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = ？ .Replacement.Text = ? .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = ！ .Replacement.Text = ! .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = .Replacement.Text = . .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.Find .Text = 。 .Replacement.Text = . .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub23 选区中文句号转半角Sub 选区中文句号转半角() With Selection.Find .Text = 。 .Replacement.Text = . .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAllEnd Sub24 把文档第一段设置为标题1的格式Sub 标题1() ActiveDocument.Paragraphs(1).Style = ActiveDocument.Styles(标题 1) Selection.ParagraphFormat.Alignment = wdAlignParagraphCenterEnd Sub25 选中的文本横向居中Sub 横向居中()With Selection.Find .Text = .Replacement.Text = .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll With Selection.ParagraphFormat .LeftIndent = CentimetersToPoints(0) 左缩进0字符 .RightIndent = CentimetersToPoints(0) 右缩进0字符 .FirstLineIndent = CentimetersToPoints(0) 首行缩进点0公分 .CharacterUnitLeftIndent = 0 左缩进单位0字符 .CharacterUnitRightIndent = 0 右缩进单位0字符 .CharacterUnitFirstLineIndent = 0 End With With Selection.ParagraphFormat .LeftIndent = CentimetersToPoints(0) 左缩进1字符 .RightIndent = CentimetersToPoints(0) 右缩进2字符 .FirstLineIndent = CentimetersToPoints(0) 首行缩进点0.35公分 .CharacterUnitLeftIndent = 0 左缩进单位0字符 .CharacterUnitRightIndent = 0 右缩进单位0字符 .CharacterUnitFirstLineIndent = 0 End With Selection.ParagraphFormat.Alignment = wdAlignParagraphCenterEnd Sub26 缩小字距Sub 缩小字距() Dim b On Error Resume Next ActiveDocument.Compatibility(wdSpacingInWholePoints) = False 不按点阵缩放字距 If Selection.Font.Spacing = 9999999 Then 当字距不等时,此值为9999999 For b = 1 To Selection.Characters.Count 得到所选字符总数 Selection.Characters(b).Font.Spacing = Selection.Characters(b).Font.Spacing - 0.1 为每个字符更改字距 Next b Else Selection.Font.Spacing = Selection.Font.Spacing - 0.1 End IfEnd Sub27 增大字距Sub 增大字距() On Error Resume Next ActiveDocument.Compatibility(wdSpacingInWholePoints) = False 不按点阵缩放字距 Dim b If Selection.Font.Spacing = 9999999 Then 当字距不等时,此值为9999999 For b = 1 To Selection.Characters.Count 得到所选字符总数 Selection.Characters(b).Font.Spacing = Selection.Characters(b).Font.Spacing + 0.1 为每个字符更改字距 Next b Else Selection.Font.Spacing = Selection.Font.Spacing + 0.1 End IfEnd Sub28 缩小行距Sub 缩小行距() Dim b On Error Resume Next StatusBar = 老刘郑重提示: 该命令会取消行自动对齐到行网格！ With Selection.ParagraphFormat .AutoAdjustRightIndent = False 不自动调整右缩进 .DisableLineHeightGrid = True 不自动对齐行网格 End With If Selection.ParagraphFormat.LineSpacing = 9999999 Then For b = 1 To Selection.Paragraphs.Count Selection.Paragraphs(b).LineSpacing = Selection.Paragraphs(b).LineSpacing * 0.95 Next b Else Selection.ParagraphFormat.LineSpacing = Selection.ParagraphFormat.LineSpacing * 0.95 End IfEnd Sub29 增大行距Sub 增大行距() Dim b On Error Resume Next StatusBar = 老刘郑重提示: 该命令会取消行自动对齐到行网格！ With Selection.ParagraphFormat .AutoAdjustRightIndent = False 不自动调整右缩进 .DisableLineHeightGrid = True 不自动对齐行网格 End With If Selection.ParagraphFormat.LineSpacing = 9999999 Then 当段落间距不等时,此值为9999999 For b = 1 To Selection.Paragraphs.Count 得到所选段落总数 Selection.Paragraphs(b).LineSpacing = Selection.Paragraphs(b).LineSpacing * 1.05 Next b Else Selection.ParagraphFormat.LineSpacing = Selection.ParagraphFormat.LineSpacing * 1.05 End IfEnd Sub30 等高变宽Sub 等高变宽() On Error Resume Next Selection.Font.Scaling = Selection.Font.Scaling + 1End Sub31 等高变窄Sub 等高变窄() On Error Resume Next Selection.Font.Scaling = Selection.Font.Scaling - 1End Sub32 字表间距Sub 字表间距() On Error Resume Next ActiveDocument.Compatibility(wdAlignTablesRowByRow) = False Selection.Tables(1).Select With Selection.Borders(wdBorderTop) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth150pt .Color = Options.DefaultBorderColor End With With Selection.Borders(wdBorderLeft) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth150pt .Color = Options.DefaultBorderColor End With With Selection.Borders(wdBorderBottom) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth150pt .Color = Options.DefaultBorderColor End With With Selection.Borders(wdBorderRight) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth150pt .Color = Options.DefaultBorderColor End With On Error GoTo a: Selection.Tables(1).Rows.Alignment = wdAlignRowCenter Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter Selection.Rows.SpaceBetweenColumns = 0 Selection.Tables(1).AllowAutoFit = Falsea: If Err = 4605 Then MsgBox 当前位置不在表格中,请重新定义。, vbInformation, 刘厚彬现在轻轻地告诉你 End IfEnd Sub33 纵向16开Sub 纵向16开() With ActiveDocument.Range(Start:=Selection.Start, End:=ActiveDocument. _ Content.End).PageSetup 插入点之后With ActiveDocument.PageSetup 整篇文档With Selection.PageSetup 本节 .Orientation = wdOrientPortrait 纵向 .TopMargin = MillimetersToPoints(24) .BottomMargin = MillimetersToPoints(25) .LeftMargin = MillimetersToPoints(28) .RightMargin = MillimetersToPoints(25) .FooterDistance = MillimetersToPoints(21) .PageWidth = MillimetersToPoints(196) .PageHeight = MillimetersToPoints(270) .FirstPageTray = wdPrinterDefaultBin .OtherPagesTray = wdPrinterDefaultBinEnd WithEnd Sub34 插入页码Sub 插入页码() Dim fstpg As Byte Dim mydialog As Dialog Dim a As String On Error Resume Next fstpg = 1 ActiveWindow.View.ShowFieldCodes = False 隐藏窗口域代码 Set mydialog = Dialogs(wdDialogInsertPageNumbers) If mydialog.Display = -1 Then -2关闭；-1确定；0取消；1第一个按钮，2第二个按钮，以此类推。 If mydialog.firstpage = False Then 判断首页是否打印页码 mydialog.firstpage = True fstpg = False End If mydialog.Execute ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter 切换到页脚 Selection.SetRange Start:=0, End:=4 选定前3个字符文本 If VBA.Mid$(Selection.text, 1, 1) Then Selection.EndKey Unit:=wdLine Selection.TypeText text:= Selection.MoveLeft Unit:=wdCharacter, Count:=5 Selection.