Word宏代码集锦.doc

Word宏代码集锦Word宏代码集锦一、修改word格式：1、智能清除选区软回车（换行符）2、清除选区多余空段3、合并选区中“，”结束的多余分段4、清除选区单字节空格5、清除选区单字节空格6、清除选区1字空格7、清除选区段首2字空格8、清除选区Tab9、增加选区空格10、选区段首缩进0字11、选区段首缩进:2字12、选区段首缩进转空格已完美13、选区段后间距1行14、选区段后间距1行15、选区段后间距1行16、清除选区图片17、选区硬回车转软回车18、清除选区软回车19合并选区段落20、选区空格转硬回车21、选区标点半角转全角22、选区标点全角转半角23、选区中文句号转半角24、把文档第一段设置为标题1的格式25、选中的文本横向居中26、缩小字距27、增大字距28、缩小行距29、增大行距30、等高变宽31、等高变窄32、字表间距33、纵向16开34、插入页码35、小写金额转大写金额二、其它1.调整图片大小2.转字体3.转文件格式4、文件加密5、字符替换6、替换引号7、打印为PDF格式文件8、朗读文本9.文献标号上标化10.箭头上方加文字11添加参考文献格式一，参考文献在文档末尾以123格式排列12.添加参考文献格式二，参考文献在文档末尾以1 2 3格式排列，修改自格式一的代码13.返回正文14.再次引用已有参考文献15.查找被删参考文献遗留引用，16、统计修订的字数17、快速提取脚注内容18、从任意页面编排页码19、批量实现缩放打印20、对文档内容进行顺序排列21、替换Word文档插图的超链接22、为文档的每页添加固定内容23、批量实现图片的等比例缩一、修改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 = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = 1l.Replacement.Text = &pEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = l.Replacement.Text = End WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub2、清除选区多余空段Sub清除选区多余空段()With Selection.Find.Text = pp.Replacement.Text = p.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = ppp.Replacement.Text = p.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = ppp.Replacement.Text = p.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = pp.Replacement.Text = p.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = pp.Replacement.Text = p.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = ppp.Replacement.Text = p.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = p .Replacement.Text = p.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = pp.Replacement.Text = p.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = pp.Replacement.Text = p.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub3、合并选区中“，”结束的多余分段Sub合并选区多余分段()With Selection.Find.Text = ，p.Replacement.Text = ，.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = 、p.Replacement.Text = 、.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub4、清除选区单字节空格Sub清除选区单字节空格()With Selection.Find.Text = .Replacement.Text = .MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub5、清除选区单字节空格Sub清除选区2单字节空格()With Selection.Find.Text = .Replacement.Text = .MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub6、清除选区1字空格Sub清除选区1字空格()With Selection.Find.Text = .Replacement.Text = .MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub7、清除选区段首2字空格Sub清除选区段首2字空格()With Selection.Find.Text = .Replacement.Text = .MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub8、清除选区TabSub清除选区Tab()With Selection.Find.Text = vbTab.Replacement.Text = .MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub9、增加选区空格Sub增加选区空格()With Selection.Find.Text = .Replacement.Text = .MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub10、选区段首缩进0字Sub选区段首无缩进()With Selection.Find.Text = .Replacement.Text = .MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.ParagraphFormat.LeftIndent = CentimetersToPoints(0)左缩进0字符.RightIndent = CentimetersToPoints(0)右缩进0字符.FirstLineIndent = CentimetersToPoints(0)首行缩进点0公分.CharacterUnitLeftIndent = 0左缩进单位0字符.CharacterUnitRightIndent= 0右缩进单位0字符.CharacterUnitFirstLineIndent = 0End WithWith Selection.ParagraphFormat.LeftIndent = CentimetersToPoints(0)左缩进1字符.RightIndent = CentimetersToPoints(0)右缩进2字符.FirstLineIndent = CentimetersToPoints(0)首行缩进点0.35公分.CharacterUnitLeftIndent = 0左缩进单位0字符.CharacterUnitRightIndent= 0右缩进单位0字符.CharacterUnitFirstLineIndent = 0End 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 = 2End WithEnd Sub12、选区段首缩进转空格已完美Sub选区段首缩进转空格()Selection.InsertParagraphBeforeCall选区段首无缩进With Selection.Find.Text = p.Replacement.Text = p.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllSelection.DeleteWith Selection.Find.Text = p.Replacement.Text = .MatchWildcards = FalseEnd WithSelection.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.5Selection.ParagraphFormat.LineUnitAfter = 0.5End Sub15、选区段后间距1行Sub选区段前段后无间距()Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(0)Selection.ParagraphFormat.LineUnitBefore = 0Selection.ParagraphFormat.LineUnitAfter = 0End Sub16、清除选区图片Sub清除选区图片()With Selection.Find.Text = 1.Replacement.Text = .MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub17、选区硬回车转软回车Sub选区硬回车转软回车()With Selection.Find.Text = p.Replacement.Text = l.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub18、清除选区软回车Sub清除选区软回车()With Selection.Find.Text = l.Replacement.Text = .MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub19合并选区段落Sub合并选区段落()With Selection.Find.Text = .Replacement.Text = .MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = p.Replacement.Text = l.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = l.Replacement.Text = .MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAllSelection.Paragraphs.Add添加段落符号End Sub20、选区空格转硬回车Sub选区空格转硬回车()With Selection.Find.Text = .Replacement.Text = p.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub21、选区标点半角转全角Sub选区标点半角转全角()With Selection.Find.Text = ,.Replacement.Text = ，.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = ;.Replacement.Text = ；.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = :.Replacement.Text = ：.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = ?.Replacement.Text = ？.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = !.Replacement.Text = ！.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = .Replacement.Text = .MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = .Replacement.Text = 。.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub22、选区标点全角转半角Sub选区标点全角转半角()With Selection.Find.Text = ，.Replacement.Text = ,.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = ；.Replacement.Text = ;.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = ：.Replacement.Text = :.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = ？.Replacement.Text = ?.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = ！.Replacement.Text = !.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = .Replacement.Text = .MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.Find.Text = 。.Replacement.Text = .MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllEnd Sub23、选区中文句号转半角Sub选区中文句号转半角()With Selection.Find.Text = 。.Replacement.Text = .MatchWildcards = FalseEnd WithSelection.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 = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllWith Selection.ParagraphFormat.LeftIndent = CentimetersToPoints(0)左缩进0字符.RightIndent = CentimetersToPoints(0)右缩进0字符.FirstLineIndent = CentimetersToPoints(0)首行缩进点0公分.CharacterUnitLeftIndent = 0左缩进单位0字符.CharacterUnitRightIndent= 0右缩进单位0字符.CharacterUnitFirstLineIndent = 0End WithWith Selection.ParagraphFormat.LeftIndent = CentimetersToPoints(0)左缩进1字符.RightIndent = CentimetersToPoints(0)右缩进2字符.FirstLineIndent = CentimetersToPoints(0)首行缩进点0.35公分.CharacterUnitLeftIndent = 0左缩进单位0字符.CharacterUnitRightIndent= 0右缩进单位0字符.CharacterUnitFirstLineIndent = 0End WithSelection.ParagraphFormat.Alignment = wdAlignParagraphCenterEnd Sub26、缩小字距Sub缩小字距()Dim bOn Error Resume NextActiveDocument.Compatibility(wdSpacingInWholePoints) = False不按点阵缩放字距If Selection.Font.Spacing = 9999999 Then当字距不等时,此值为9999999For b = 1 To Selection.Characters.Count 得到所选字符总数Selection.Characters(b).Font.Spacing = Selection.Characters(b).Font.Spacing - 0.1 为每个字符更改字距Next bElseSelection.Font.Spacing = Selection.Font.Spacing - 0.1End IfEnd Sub27、增大字距Sub增大字距()On Error Resume NextActiveDocument.Compatibility(wdSpacingInWholePoints) = False不按点阵缩放字距Dim bIf Selection.Font.Spacing = 9999999 Then当字距不等时,此值为9999999For b = 1 To Selection.Characters.Count 得到所选字符总数Selection.Characters(b).Font.Spacing = Selection.Characters(b).Font.Spacing + 0.1 为每个字符更改字距Next bElseSelection.Font.Spacing = Selection.Font.Spacing + 0.1End IfEnd Sub28、缩小行距Sub缩小行距()Dim bOn Error Resume NextStatusBar = 老刘郑重提示:该命令会取消行自动对齐到行网格！With Selection.ParagraphFormat.AutoAdjustRightIndent = False不自动调整右缩进.DisableLineHeightGrid = True不自动对齐行网格End WithIf Selection.ParagraphFormat.LineSpacing = 9999999 ThenFor b = 1 To Selection.Paragraphs.CountSelection.Paragraphs(b).LineSpacing = Selection.Paragraphs(b).LineSpacing * 0.95Next bElseSelection.ParagraphFormat.LineSpacing = Selection.ParagraphFormat.LineSpacing * 0.95End IfEnd Sub29、增大行距Sub增大行距()Dim bOn Error Resume NextStatusBar = 老刘郑重提示:该命令会取消行自动对齐到行网格！With Selection.ParagraphFormat.AutoAdjustRightIndent = False不自动调整右缩进.DisableLineHeightGrid = True不自动对齐行网格End WithIf Selection.ParagraphFormat.LineSpacing = 9999999 Then当段落间距不等时,此值为9999999For b = 1 To Selection.Paragraphs.Count得到所选段落总数Selection.Paragraphs(b).LineSpacing = Selection.Paragraphs(b).LineSpacing * 1.05Next bElseSelection.ParagraphFormat.LineSpacing = Selection.ParagraphFormat.LineSpacing * 1.05End IfEnd Sub30、等高变宽Sub等高变宽()On Error Resume NextSelection.Font.Scaling = Selection.Font.Scaling + 1End Sub31、等高变窄Sub等高变窄()On Error Resume NextSelection.Font.Scaling = Selection.Font.Scaling - 1End Sub32、字表间距Sub字表间距()On Error Resume NextActiveDocument.Compatibility(wdAlignTablesRowByRow) = FalseSelection.Tables(1).SelectWith Selection.Borders(wdBorderTop).LineStyle = wdLineStyleSingle.LineWidth = wdLineWidth150pt.Color = Options.DefaultBorderColorEnd WithWith Selection.Borders(wdBorderLeft).LineStyle = wdLineStyleSingle.LineWidth = wdLineWidth150pt.Color = Options.DefaultBorderColorEnd WithWith Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle.LineWidth = wdLineWidth150pt.Color = Options.DefaultBorderColorEnd WithWith Selection.Borders(wdBorderRight).LineStyle = wdLineStyleSingle.LineWidth = wdLineWidth150pt.Color = Options.DefaultBorderColorEnd WithOn Error GoTo a:Selection.Tables(1).Rows.Alignment = wdAlignRowCenterSelection.Cells.VerticalAlignment = wdCellAlignVerticalCenterSelection.Rows.SpaceBetweenColumns = 0Selection.Tables(1).AllowAutoFit = Falsea:If Err = 4605 ThenMsgBox 当前位置不在表格中,请重新定义。, 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 ByteDim mydialog As DialogDim a As StringOn Error Resume Nextfstpg = 1ActiveWindow.View.ShowFieldCodes = False 隐藏窗口域代码Set mydialog = Dialogs(wdDialogInsertPageNumb