Word宏代码集锦

Word宏代码集锦Word宏代码集锦1一、修改word格式：11、 智能清除选区软回车（换行符）12、 清除选区多余空段13、 合并选区中“，”结束的多余分段34、 清除选区单字节空格35、 清除选区单字节空格46、 清除选区1字空格47、 清除选区段首2字空格48、 清除选区Tab59、 增加选区空格510、 选区段首缩进0字511、 选区段首缩进:2字612、 选区段首缩进转空格已完美613、 选区段后间距1行714、 选区段后间距1行715、 选区段后间距1行716、 清除选区图片817、 选区硬回车转软回车818、 清除选区软回车819 合并选区段落920、 选区空格转硬回车921、 选区标点半角转全角1022、 选区标点全角转半角1123、 选区中文句号转半角1224、把文档第一段设置为标题1的格式1225、选中的文本横向居中1326、缩小字距1327、增大字距1428、缩小行距1429、增大行距1530、等高变宽1531、等高变窄1532、字表间距1633、纵向16开1634、插入页码1735、小写金额转大写金额18二、其它231.调整图片大小232.转字体243.转文件格式254、文件加密275、字符替换276、替换引号287、打印为PDF格式文件298、朗读文本299. 文献标号上标化2910. 箭头上方加文字3011 添加参考文献格式一，参考文献在文档末尾以1 2 3 格式排列3012. 添加参考文献格式二，参考文献在文档末尾以1 2 3 格式排列，修改自格式一的代码3113. 返回正文3214. 再次引用已有参考文献3215. 查找被删参考文献遗留引用，3216、统计修订的字数3317、快速提取脚注内容3318、从任意页面编排页码3419、批量实现缩放打印3520、对文档内容进行顺序排列3621、替换Word文档插图的超链接3622、为文档的每页添加固定内容3723、批量实现图片的等比例缩372一、 修改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:=wdReplaceAll End 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:=wdReplaceAll End 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:=wdReplaceAll End 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 With End 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:=wdReplaceAll End Sub13、 选区段后间距1行Sub 选区段后间距1行() Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0) Selection.ParagraphFormat.LineUnitAfter = 1 End 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:=wdReplaceAll End Sub17、 选区硬回车转软回车Sub 选区硬回车转软回车() With Selection.Find .Text = p .Replacement.Text = l .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll End Sub18、 清除选区软回车Sub 清除选区软回车() With Selection.Find .Text = l .Replacement.Text = .MatchWildcards = True End With Selection.Find.Execute Replace:=wdReplaceAll End 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 Sub 21、 选区标点半角转全角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:=wdReplaceAll End 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:=wdReplaceAll End 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 = Then 当字距不等时,此值为 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 = Then 当字距不等时,此值为 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 = 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 = Then 当段落间距不等时,此值为 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