Word宏代码集锦

Word宏代码集锦1Word宏代码集锦1一、修改word格式：11、'智能清除选区软回车（换行符）12、'清除选区多余空段33、'合并选区中“，”结束的多余分段34、'清除选区单字节空格45、'清除选区单字节空格46、'清除选区1字空格47、'清除选区段首2字空格58、'清除选区Tab59、'增加选区空格510、'选区段首缩进0字611、'选区段首缩进:2字612、'选区段首缩进转空格—已完美713、'选区段后间距1行714、'选区段后间距1行715、'选区段后间距1行816、'清除选区图片817、'选区硬回车转软回车818、'清除选区软回车919'合并选区段落920、'选区空格转硬回车1021、'选区标点半角转全角1122、'选区标点全角转半角1223、'选区中文句号转半角1224、’把文档第一段设置为标题1的格式1325、选中的文本横向居中1326、缩小字距1427、增大字距1428、缩小行距1529、增大行距1530、等高变宽1531、等高变窄1632、字间距1633、纵向16开1734、插入页码1835、小写金额转大写金额23二、其它231.调整图片大小242.转字体253.转文件格式274、文件加密275、字符替换286、替换引号297、打印为PDF格式文件298、朗读文本299.文献标号上标化3010.箭头上方加文字3011添加参考文献格式一，参考文献在文档末尾以1．2．3．格式排列3112.添加参考文献格式二，参考文献在文档末尾以[1][2][3]格式排列，修改自格式一的代码3213.返回正文3214.再次引用已有参考文献3215.查找被删参考文献遗留引用，3316、统计修订的字数3317、快速提取脚注内容3418、从任意页面编排页码3519、批量实现缩放打印3620、对文档内容进行顺序排列3621、替换Word文档插图的超链接3722、为文档的每页添加固定内容3723、批量实现图片的等比例缩1、修改word格式：1、'智能清除选区软回车（换行符）Sub智能清除选区软回车()WithSelection.Find.Text="?^l".Replacement.Text="^&^p".Forward=True.Wrap=wdFindContinue.Format=False.MatchCase=False.MatchWholeWord=False.MatchByte=False.MatchAllWordForms=False.MatchSoundsLike=False.MatchWildcards=TrueEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="^1^l".Replacement.Text="^&^p"EndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="^l".Replacement.Text=""EndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub2、'清除选区多余空段Sub清除选区多余空段()WithSelection.Find.Text="^p^p".Replacement.Text="^p".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="^p^p^p".Replacement.Text="^p".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="^p^p^p".Replacement.Text="^p".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="^p^p".Replacement.Text="^p".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="^p^p".Replacement.Text="^p".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="^p^p^p".Replacement.Text="^p".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="^p".Replacement.Text="^p".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="^p^p".Replacement.Text="^p".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="^p^p".Replacement.Text="^p".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub3、'合并选区中“，”结束的多余分段Sub合并选区多余分段()WithSelection.Find.Text="，^p".Replacement.Text="，".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="、^p".Replacement.Text="、".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub4、'清除选区单字节空格Sub清除选区单字节空格()WithSelection.Find.Text="".Replacement.Text="".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub5、'清除选区单字节空格Sub清除选区2单字节空格()WithSelection.Find.Text="".Replacement.Text="".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub6、'清除选区1字空格Sub清除选区1字空格()WithSelection.Find.Text="　".Replacement.Text="".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub7、'清除选区段首2字空格Sub清除选区段首2字空格()WithSelection.Find.Text="　　".Replacement.Text="".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub8、'清除选区TabSub清除选区Tab()WithSelection.Find.Text=vbTab.Replacement.Text="".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub9、'增加选区空格Sub增加选区空格()WithSelection.Find.Text="　".Replacement.Text="　　".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub10、'选区段首缩进0字Sub选区段首无缩进()WithSelection.Find.Text="　".Replacement.Text="".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.ParagraphFormat.LeftIndent=CentimetersToPoints(0)'左缩进0字符.RightIndent=CentimetersToPoints(0)'右缩进0字符.FirstLineIndent=CentimetersToPoints(0)'首行缩进点0公分.CharacterUnitLeftIndent=0'左缩进单位0字符.CharacterUnitRightIndent=0'右缩进单位0字符.CharacterUnitFirstLineIndent=0EndWithWithSelection.ParagraphFormat.LeftIndent=CentimetersToPoints(0)'左缩进1字符.RightIndent=CentimetersToPoints(0)'右缩进2字符.FirstLineIndent=CentimetersToPoints(0)'首行缩进点0.35公分.CharacterUnitLeftIndent=0'左缩进单位0字符.CharacterUnitRightIndent=0'右缩进单位0字符.CharacterUnitFirstLineIndent=0EndWithEndSub11、'选区段首缩进:2字Sub选区段首缩进2字()WithSelection.ParagraphFormat.LeftIndent=CentimetersToPoints(0)'左缩进1字符.RightIndent=CentimetersToPoints(0)'右缩进2字符.FirstLineIndent=CentimetersToPoints(0.35)'首行缩进点单位公分.CharacterUnitLeftIndent=0'左缩进单位0字符.CharacterUnitRightIndent=0'右缩进单位0字符.CharacterUnitFirstLineIndent=2EndWithEndSub12、'选区段首缩进转空格—已完美Sub选区段首缩进转空格()Selection.InsertParagraphBeforeCall选区段首无缩进WithSelection.Find.Text="^p".Replacement.Text="^p　　".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllSelection.DeleteWithSelection.Find.Text="　　^p".Replacement.Text="".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub13、'选区段后间距1行Sub选区段后间距1行()Selection.ParagraphFormat.FirstLineIndent=CentimetersToPoints(0)Selection.ParagraphFormat.LineUnitAfter=1EndSub14、'选区段后间距1行Sub选区段前段后间距半行()Selection.ParagraphFormat.FirstLineIndent=CentimetersToPoints(0)Selection.ParagraphFormat.LineUnitBefore=0.5Selection.ParagraphFormat.LineUnitAfter=0.5EndSub15、'选区段后间距1行Sub选区段前段后无间距()Selection.ParagraphFormat.FirstLineIndent=CentimetersToPoints(0)Selection.ParagraphFormat.LineUnitBefore=0Selection.ParagraphFormat.LineUnitAfter=0EndSub16、'清除选区图片Sub清除选区图片()WithSelection.Find.Text="^1".Replacement.Text="".MatchWildcards=TrueEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub17、'选区硬回车转软回车Sub选区硬回车转软回车()WithSelection.Find.Text="^p".Replacement.Text="^l".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub18、'清除选区软回车Sub清除选区软回车()'WithSelection.Find.Text="^l".Replacement.Text="".MatchWildcards=TrueEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub19'合并选区段落Sub合并选区段落()WithSelection.Find.Text="　　".Replacement.Text="".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="^p".Replacement.Text="^l".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="^l".Replacement.Text="".MatchWildcards=TrueEndWithSelection.Find.ExecuteReplace:=wdReplaceAllSelection.Paragraphs.Add'添加段落符号EndSub20、'选区空格转硬回车Sub选区空格转硬回车()WithSelection.Find.Text="　".Replacement.Text="^p".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub21、'选区标点半角转全角Sub选区标点半角转全角()WithSelection.Find.Text=",".Replacement.Text="，".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text=";".Replacement.Text="；".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text=":".Replacement.Text="：".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="?".Replacement.Text="？".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="!".Replacement.Text="！".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="......".Replacement.Text="……".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text=".".Replacement.Text="。".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub22、'选区标点全角转半角Sub选区标点全角转半角()WithSelection.Find.Text="，".Replacement.Text=",".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="；".Replacement.Text=";".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="：".Replacement.Text=":".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="？".Replacement.Text="?".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="！".Replacement.Text="!".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="……".Replacement.Text="......".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.Find.Text="。".Replacement.Text=".".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub23、'选区中文句号转半角Sub选区中文句号转半角()WithSelection.Find.Text="。".Replacement.Text=".".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub24、’把文档第一段设置为标题1的格式Sub标题1()ActiveDocument.Paragraphs(1).Style=ActiveDocument.Styles("标题1")Selection.ParagraphFormat.Alignment=wdAlignParagraphCenterEndSub25、选中的文本横向居中Sub横向居中()WithSelection.Find.Text="　".Replacement.Text="".MatchWildcards=FalseEndWithSelection.Find.ExecuteReplace:=wdReplaceAllWithSelection.ParagraphFormat.LeftIndent=CentimetersToPoints(0)'左缩进0字符.RightIndent=CentimetersToPoints(0)'右缩进0字符.FirstLineIndent=CentimetersToPoints(0)'首行缩进点0公分.CharacterUnitLeftIndent=0'左缩进单位0字符.CharacterUnitRightIndent=0'右缩进单位0字符.CharacterUnitFirstLineIndent=0EndWithWithSelection.ParagraphFormat.LeftIndent=CentimetersToPoints(0)'左缩进1字符.RightIndent=CentimetersToPoints(0)'右缩进2字符.FirstLineIndent=CentimetersToPoints(0)'首行缩进点0.35公分.CharacterUnitLeftIndent=0'左缩进单位0字符.CharacterUnitRightIndent=0'右缩进单位0字符.CharacterUnitFirstLineIndent=0EndWithSelection.ParagraphFormat.Alignment=wdAlignParagraphCenterEndSub26、缩小字距Sub缩小字距()DimbOnErrorResumeNextActiveDocument.Compatibility(wdSpacingInWholePoints)=False'不按点阵缩放字距IfSelection.Font.Spacing=9999999Then'当字距不等时,此值为9999999Forb=1ToSelection.Characters.Count'得到所选字符总数Selection.Characters(b).Font.Spacing=Selection.Characters(b).Font.Spacing-0.1'为每个字符更改字距NextbElseSelection.Font.Spacing=Selection.Font.Spacing-0.1EndIfEndSub27、增大字距Sub增大字距()OnErrorResumeNextActiveDocument.Compatibility(wdSpacingInWholePoints)=False'不按点阵缩放字距DimbIfSelection.Font.Spacing=9999999Then'当字距不等时,此值为9999999Forb=1ToSelection.Characters.Count'得到所选字符总数Selection.Characters(b).Font.Spacing=Selection.Characters(b).Font.Spacing+0.1'为每个字符更改字距NextbElseSelection.Font.Spacing=Selection.Font.Spacing+0.1EndIfEndSub28、缩小行距Sub缩小行距()DimbOnErrorResumeNextStatusBar="老刘郑重提示:该命令会取消行自动对齐到行网格！"WithSelection.ParagraphFormat.AutoAdjustRightIndent=False'不自动调整右缩进.DisableLineHeightGrid=True'不自动对齐行网格EndWithIfSelection.ParagraphFormat.LineSpacing=9999999ThenForb=1ToSelection.Paragraphs.CountSelection.Paragraphs(b).LineSpacing=Selection.Paragraphs(b).LineSpacing*0.95NextbElseSelection.ParagraphFormat.LineSpacing=Selection.ParagraphFormat.LineSpacing*0.95EndIfEndSub29、增大行距Sub增大行距()DimbOnErrorResumeNextStatusBar="老刘郑重提示:该命令会取消行自动对齐到行网格！"WithSelection.ParagraphFormat.AutoAdjustRightIndent=False'不自动调整右缩进.DisableLineHeightGrid=True'不自动对齐行网格EndWithIfSelection.ParagraphFormat.LineSpacing=9999999Then'当段落间距不等时,此值为9999999Forb=1ToSelection.Paragraphs.Count'得到所选段落总数Selection.Paragraphs(b).LineSpacing=Selection.Paragraphs(b).LineSpacing*1.05NextbElseSelection.ParagraphFormat.LineSpacing=Selection.ParagraphFormat.LineSpacing*1.05EndIfEndSub30、等高变宽Sub等高变宽()OnErrorResumeNextSelection.Font.Scaling=Selection.Font.Scaling+1EndSub31、等高变窄Sub等高变窄()OnErrorResumeNextSelection.Font.Scaling=Selection.Font.Scaling-1EndSub32、字表间距Sub字表间距()OnErrorResumeNextActiveDocument.Compatibility(wdAlignTablesRowByRow)=FalseSelection.Tables(1).SelectWithSelection.Borders(wdBorderTop).LineStyle=wdLineStyleSingle.LineWidth=wdLineWidth150pt.Color=Options.DefaultBorderColorEndWithWithSelection.Borders(wdBorderLeft).LineStyle=wdLineStyleSingle.LineWidth=wdLineWidth150pt.Color=Options.DefaultBorderColorEndWithWithSelection.Borders(wdBorderBottom).LineStyle=wdLineStyleSingle.LineWidth=wdLineWidth150pt.Color=Options.DefaultBorderColorEndWithWithSelection.Borders(wdBorderRight).LineStyle=wdLineStyleSingle.LineWidth=wdLineWidth150pt.Color=Options.DefaultBorderColorEndWithOnErrorGoToa:Selection.Tables(1).Rows.Alignment=wdAlignRowCenterSelection.Cells.VerticalAlignment=wdCellAlignVerticalCenterSelection.Rows.SpaceBetweenColumns=0Selection.Tables(1).AllowAutoFit=Falsea:IfErr=4605ThenMsgBox"当前位置不在中,请重新定义。",vbInformation,"刘厚彬现在轻轻地告诉你"EndIfEndSub33、纵向16开Sub纵向16开()'WithActiveDocument.Range(Start:=Selection.Start,End:=ActiveDocument._Content.End).PageSetup'插入点之后'WithActiveDocument.PageSetup'整篇文档WithSelection.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=wdPrinterDefaultBinEndWithEndSub34、插入页码Sub插入页码()DimfstpgAsByteDimmydialogAsDialogDimaAsStringOnErrorResumeNextfstpg=1ActiveWindow.View.ShowFieldCodes=False'隐藏窗口域代码Setmydialog=Dialogs(wdDialogInsertPageNumbers)Ifmydialog.Display=-1Then'-2关闭；-1确定；0取消；1第一个按钮，2第二个按钮，以此类推。Ifmydialog.firstpage=FalseThen'判断首页是否打印页码mydialog.firstpage=Truefstpg=FalseEndIfmydialog.ExecuteActiveWindow.ActivePane.View.SeekView=wdSeekCurrentPageFooter'切换到页脚Selection.SetRangeStart:=0,End:=4'选定前3个字符文本IfVBA.Mid$(Selection.text,1,1)<>"—"ThenSelection.EndKeyUnit:=wdLineSelection.TypeTexttext:="—"Selection.MoveLeftUnit:=wdCharacter,Count:=5Selection.TypeTexttext:="—"Selection.ParagraphFormat.CharacterUnitRightIndent=0.75Selection.ParagraphFormat.CharacterUnitFirstLineIndent=1.19EndIfIffstpg=FalseThenmydialog.firstpage=Falsemydialog.Execute'首页不显示页码EndIfActiveWindow.ActivePane.View.SeekView=wdSeekMainDocumentEndIfEndSub35、小写金额转大写金额Sub大写金额()DimBigNum,snum,i,mydataAsDataObjectOnErrorGoToeSetmydata=NewDataObjectBigNum=""snum=Selection.textIfIsNumeric(snum)=FalseThenmydata.GetFromClipboard'从剪切板取值snum=mydata.GetText(1)EndIfsnum=VBA.Trim(VBA.str(Int(Round(snum,2)*100)))Ifsnum<0Thensnum=-snum:BigNum="负"Ifsnum=0ThenBigNum="零元整"ElseConstcNum="零壹贰叁肆伍陆柒捌玖-万仟佰拾亿仟佰拾万仟佰拾元角分"ConstcCha="零仟零佰零拾零零零零零亿零万零元亿万零角零分零整-零零零零零亿万元亿零整整"Fori=1ToLen(snum)'逐位转换BigNum=BigNum+VBA.Mid(cNum,(VBA.Mid(snum,i,1))+1,1)+VBA.Mid(cNum,26-Len(snum)+i,1)NextiBigNum=Replace(BigNum,"零亿","亿零")BigNum=Replace(BigNum,"零万","万零")BigNum=Replace(BigNum,"零元","元零")Fori=0To11'去掉多余的零BigNum=Replace(BigNum,VBA.Mid(cCha,i*2+1,2),VBA.Mid(cCha,i+26,1))NextiEndIfSelection.MoveRightSelection.TypeTexttext:=BigNumEnde:MsgBox"你输入数字错误或太大!请重新输入。",vbExclamation+vbOKOnly,"提示"EndSub36、’去掉空白行Sub去掉空白行()Selection.HomeKeyUnit:=wdStorySelection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWithSelection.Find.Text="[^11^13]{2,}".Replacement.Text="^13".Forward=True.Wrap=wdFindContinue.Format=False.MatchCase=False.MatchWholeWord=False.MatchByte=False.MatchAllWordForms=False.MatchSoundsLike=False.MatchWildcards=TrueEndWithSelection.Find.ExecuteReplace:=wdReplaceAllApplication.GoBackEndSub37、查找替换Sub查找替换()WithActiveDocument.Content.Find.ClearFormatting'清除格式设置.Font.Name="新宋体"'查找的字体格式With.Replacement'替换条件.ClearFormatting'清除格式设置.Font.Name="黑体"'替换成黑体EndWith.Executefindtext:="",ReplaceWith:="",Format:=True,_Replace:=wdReplaceAll'是格式替换,全部替换EndWithEndSub38、：word自动化排版宏Sub 格式设置()'' 格式设置 Macro    Application.ScreenUpdating = False    '更改所有硬回车为软回车    Selection.Find.ClearFormatting    Selection.Find.Replacement.ClearFormatting    With Selection.Find        .Text = "^l"        .Replacement.Text = "^p"        .Forward = True        .Wrap = wdFindContinue        .Format = False        .MatchCase = False        .MatchWholeWord = False        .MatchByte = True        .MatchWildcards = False        .MatchSoundsLike = False        .MatchAllWordForms = False    End With    Selection.Find.Execute Replace:=wdReplaceAll    '去除所有空行    Dim i As Paragraph, n As Integer    Application.ScreenUpdating = False    For Each i In ActiveDocument.Paragraphs    If Len(i.Range) = 1 Then    i.Range.Delete    n = n + 1    End If    Next    Application.ScreenUpdating = True    '去除半角空格    Selection.Find.ClearFormatting    Selection.Find.Replacement.ClearFormatting    With Selection.Find        .Text = " "        .Replacement.Text = ""        .Forward = True        .Wrap = wdFindContinue        .Format = False        .MatchCase = False        .MatchWholeWord = False        .MatchByte = True        .MatchWildcards = False        .MatchSoundsLike = False        .MatchAllWordForms = False    End With    Selection.Find.Execute Replace:=wdReplaceAll    '去除全角空格    Selection.Find.ClearFormatting    Selection.Find.Replacement.ClearFormatting    With Selection.Find        .Text = "　"        .Replacement.Text = ""        .Forward = True        .Wrap = wdFindContinue        .Format = False        .MatchCase = False        .MatchWholeWord = False        .MatchByte = True        .MatchWildcards = False        .MatchSoundsLike = False        .MatchAllWordForms = False    End With    Selection.Find.Execute Replace:=wdReplaceAll    '替换非标准引号为标准引号    Selection.Find.ClearFormatting    Selection.Find.Replacement.ClearFormatting    With Selection.Find        .Text = """(*)"""        .Replacement.Text = ChrW(8220) & "\1" & ChrW(8221)        .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    '字母数字符号全角转半角 Macro    Dim qjsz, bjsz As String, iii As Integer '定义qjsz(全角数字)、bjsz(半角数字)为字符串型，iii为整数型        qjsz = "０１２３４５６７８９ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ,./<>?;’:[]{}\|=-+_)(        bjsz = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ，。／《》？；'：【】｛｝＼｜＝－＋＿）（        Selection.WholeStory    For iii = 1 To 95 '循环10次    With Selection.Find       .Text = Mid(qjsz, iii, 1) 'mid函数：返回文本字符串中从指定位置开始的特定数目的字符，每次取一个数字       .Replacement.Text = Mid(bjsz, iii, 1) '将用于替换的相应位置的半角数字       .Format = False '保留替换前的字符格式       .MatchWildcards = False       .Execute Replace:=wdReplaceAll '用半角符号替换全角符号    End With    Next iii    '修改小数点错误    Selection.Find.ClearFormatting    Selection.Find.Replacement.ClearFormatting    With Selection.Find        .Text = "([0-9])。([0-9])"        .Replacement.Text = "\1.\2"        .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    '设置字号    Selection.WholeStory  '全选    Selection.ClearFormatting  '清除全文格式    Selection.Font.Size = 14  '设置字号为14号    '设置行距    Selection.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly    Selection.ParagraphFormat.LineSpacing = 25    Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify  '设置文本为两端对齐    Selection.ParagraphFormat.CharacterUnitFirstLineIndent = 2  '设置段首缩进2字符    Selection.HomeKey Unit:=wdStory  '移至文首    Selection.EndKey Unit:=wdLine, Extend:=wdExtend  '选中首行    Selection.ClearFormatting  '清除首行格式    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter  '设置首行居中对齐    Selection.ParagraphFormat.LineUnitBefore = 1  '设置首行段前间距1行    Selection.ParagraphFormat.LineUnitAfter = 1  '设置首行段后间距1行    Selection.Font.Name = "微软雅黑"  '设置首行字体为“微软雅黑”    Selection.Font.Size = 18  '设置首行字号为18号    Selection.Font.Bold = wdToggle  '设置首行字形为加粗    Application.ScreenUpdating = TrueEnd Sub2、其它1.调整图片大小Subsetpicsize()'设置图片大小Dimn'图片个数OnErrorResumeNext'忽略错误Forn=1ToActiveDocument.InlineShapes.Count'InlineShapes类型图片ActiveDocument.InlineShapes(n).Height=400'设置图片高度为400pxActiveDocument.InlineShapes(n).Width=300'设置图片宽度300pxNextnForn=1ToActiveDocument.Shapes.Count'Shapes类型图片ActiveDocument.Shapes(n).Height=400'设置图片高度为400pxActiveDocument.Shapes(n).Width=300'设置图片宽度300pxNextnEndSub2.转字体Sub批量设置小5号字体()'此代码为指定文件夹中所有选取的WORD文件的进行格式设置DimMyDialogAsFileDialog,vrtSelectedItemAsVariant,DocAsDocument'OnErrorResumeNext'忽略错误'定义一个文件夹选取对话框SetMyDialog=Application.FileDialog(msoFileDialogFilePicker)WithMyDialog.Title="请选择要处理的文档（可多选）".Filters.Clear'清除所有文件筛选器中的项目.Filters.Add"所有WORD文件","*.doc",1'增加筛选器的项目为所有WORD文件.AllowMultiSelect=True'允许多项选择If.Show=-1Then'确定Application.ScreenUpdating=FalseForEachvrtSelectedItemIn.SelectedItems'在所有选取项目中循环SetDoc=Documents.Open(FileName:=vrtSelectedItem,Visible:=False)WithDocWith.ContentWith.Font'.NameFarEast="宋体"'中文字体，已禁用'.NameAscii="TimesNewRoman"'英文字体，已禁用.Size=9EndWithEndWith.CloseTrueEndWithNextApplication.ScreenUpdating=TrueEndIfEndWithMsgBox"批量设置完毕!",vbInformationEndSub3.转文件格式SubMacro1()'Macro1Macro'宏在01-10-31录制'DimnameAsString'文件名name="01"ChangeFileOpenDirectory"E:\VB_SOUCE\lib\"Fori=1To2124'文件数2124Documents.Openfilename:=name&".txt",ConfirmConversions:=False,ReadOnly:=_False,AddToRecentFiles:=False,PasswordDocument:="",PasswordTemplate:=_"",Revert:=False,WritePasswordDocument:="",WritePasswordTemplate:="",_Format:=wdOpenFormatAutoActiveDocument.SaveAsfilename:=name&".txt",FileFormat:=_wdFormatTextLineBreaks,LockComments:=False,Password:="",_AddToRecentFiles:=True,WritePassword:="",ReadOnlyRecommended:=False,_EmbedTrueTypeFonts:=False,SaveNativePictureFormat:=False,SaveFormsData_:=False,SaveAsAOCELetter:=FalseActiveWindow.Closename=name+1Ifname<10Thenname="0"&nameNextiEndSub4、文件加密submima（）withactivedocument.password="123".writepassword="456"endwithendsub‘要注意的方面：第三行是打开权限、第四行是修改权限。5、字符替换Sub字符替换()'宏名称，可修改为其他字符WithActiveDocument.Content.Find'在当前文档中进行查找.Text="其它"'被替换的字符.Replacement.Text="其他"'替换的字符.ExecuteReplace:=wdReplaceAll,Forward:=True'替换全部EndWithEndSub6、替换引号Sub替换引号()DimCountxAsInteger,iAsInteger,ShAsByte'声明变量'以下代码统计出文中的引号数目(包括""“”)Countx=0OnErrorResumeNextWithActiveDocument.Content.FindDoWhile.Execute(FindText:="""",Forward:=True,Format:=True)=TrueCountx=Countx+1Loop'以下代码判断引号是否配对出现Sh=CountxMod2IfSh<>0ThenMsgBox"引号不配对！"ExitSub'如果引号不配对，则退出宏EndIfEndWithFori=1ToCountxSh=iMod2'求i值除以2的余数IfSh<>0Then'如果余数不等于0(即为奇数)，则将相应的引号替'换为“前z”WithActiveDocument.Content.Find.Text="""".Replacement.Text="前z".ExecuteReplace:=wdReplaceOne,Forward:=TrueEndWithElseWithActiveDocument.Content.Find'反之则将相应的引号替换为“后z”.Text="""".Replacement.Text="后z".ExecuteReplace:=wdReplaceOne,Forward:=TrueEndWithEndIfNext'进行下一对引号的替换WithActiveDocument.Content.Find'以下代码将所有的“前z”替换为左引号.Text="前z".Replacement.Text="“".ExecuteReplace:=wdReplaceAll,Forward:=True'以下代码将所有的“后z”替换为右引号.Text="后z".Replacement.Text="”".ExecuteReplace:=wdReplaceAll,Forward:=TrueEndWithEndSub7、打印为PDF格式文件Sub打印为PDF格式文件()OnErrorGoToc:DimaAsBalloonDimbAsStringb=ActivePrinterOptions.PrintDrawingObjects=True'打印图形对象ActivePrinter="AcrobatPDFWriter"ActiveDocument.PrintOutc:ActivePrinter=bEndSub8、朗读文本Sub朗读文本()OnErrorResumeNextStatusBar="老刘郑重提示:执行该命令后文本如果未朗读完将不能进行其他操作！"Excel.Application.Speech.Speak(ActiveWindow.Selection)EndSub9.文献标号上标化Sub文献标号上标化()''参考文献上标化Macro'宏在2006-11-3由*****创建'Selection.HomeKeyUnit:=wdStorySelection.Find.Replacement.ClearFormattingWithSelection.Find.Replacement.Font.Superscript=TrueEndWithWithSelection.Find.Text="\[[０-９，0-9,～~－\-\　]@\]".Replacement.Text="".MatchWildcards=TrueEndWithSelection.Find.ExecuteReplace:=wdReplaceAllSelection.Find.Replacement.ClearFormattingWithSelection.Find.Replacement.Font.Superscript=TrueEndWithWithSelection.Find.Text="［[０-９，0-9,～~－\-\　]@］".Replacement.Text="".MatchWildcards=TrueEndWithSelection.Find.ExecuteReplace:=wdReplaceAllEndSub10.箭头上方加文字Sub箭头上方加文字()''箭头上方加文字Macro'宏在2008-4-16由*****创建'Selection.Fields.AddRange:=Selection.Range,Type:=wdFieldEmpty,_PreserveFormatting:=FalseSelection.TypeBackspaceSelection.DeleteUnit:=wdCharacter,Count:=1Selection.TypeTextText:="eq\o(\s\do2(──────────→),\s\up5(敲击Delete键清除此段文字，改填所需文字，酌情增减箭头长度，最后同时按下shift和F9))"Selection.MoveLeftUnit:=wdCharacter,Count:=2Selection.MoveLeftUnit:=wdWord,Count:=25,Extend:=wdExtend‘顾经宇的代码是26，改成25更好EndSub11添加参考文献格式一，参考文献在文档末尾以1．2．3．格式排列Sub添加参考文献格式一()''添加参考文献Macro'宏在2008-4-17由*****创建'Selection.Style=ActiveDocument.Styles("尾注引用")Selection.TypeTextText:="[]"Selection.MoveLeftUnit:=wdCharacter,Count:=1WithActiveDocument.Endnotes.StartingNumber=1.NumberStyle=wdNoteNumberStyleArabicEndWithActiveDocument.Endnotes.AddRange:=Selection.Range,Reference:=""Selection.MoveLeftUnit:=wdCharacter,Count:=1Selection.MoveLeftUnit:=wdCharacter,Count:=1,Extend:=wdExtendSelection.Style=ActiveDocument.Styles("默认段落字体")Selection.MoveRightUnit:=wdCharacter,Count:=1Selection.DeleteUnit:=wdCharacter,Count:=1Selection.TypeTextText:="．"EndSub12.添加参考文献格式二，参考文献在文档末尾以[1][2][3]格式排列，修改自格式一的代码Sub添加参考文献格式二()''添加参考文献Macro'宏在2008-4-17由*****创建'Selection.Style=ActiveDocument.Styles("尾注引用")Selection.TypeTextText:="[]"Selection.MoveLeftUnit:=wdCharacter,Count:=1WithActiveDocument.Endnotes.StartingNumber=1.NumberStyle=wdNoteNumberStyleArabicEndWithActiveDocument.Endnotes.AddRange:=Selection.Range,Reference:=""Selection.MoveLeftUnit:=wdCharacter,Count:=1Selection.MoveLeftUnit:=wdCharacter,Count:=1,Extend:=wdExtendSelection.Style=ActiveDocument.Styles("默认段落字体")Selection.MoveRightUnit:=wdCharacter,Count:=1Selection.DeleteUnit:=wdCharacter,Count:=1Selection.TypeTextText:="]"Selection.MoveLeftUnit:=wdCharacter+2,Count:=1Selection.TypeTextText:="["EndSub13.返回正文Sub返回正文()'返回正文Macro'宏在2008-4-16由*****创建'IfActiveWindow.ActivePane.View.Type=wdPageViewOrActiveWindow._ActivePane.View.Type=wdOnlineViewOrActiveWindow.ActivePane.View.Type_=wdPrintPreviewThenActiveWindow.View.SeekView=wdSeekMainDocumentElseActiveWindow.Panes(2).CloseEndIfSelection.MoveRightUnit:=wdCharacter,Count:=2EndSub14.再次引用已有参考文献Sub引用编号()'引用编号Macro'宏在2008-4-16由*****创建'Selection.Font.Superscript=wdToggleSelection.TypeTextText:="[]"Selection.MoveLeftUnit:=wdCharacter,Count:=1WithDialogs(wdDialogInsertCrossReference).InsertAsHyperlink=True.ShowEndWithSelection.MoveRightUnit:=wdCharacter,Count:=1Selection.Font.Superscript=wdToggleEndSub15.查找被删参考文献遗留引用，Sub查找被删编号()'要删除某个参考文献，应该在原始引用处删除引用，这样可以一并删除参考文献，而不是在文档末尾文献列表处删除Selection.WholeStorySelection.Fields.UpdateSelection.Find.ClearFormattingWithSelection.Find.Text="错误！未定义书签。"EndWithSelection.Find.ExecuteSelection.MoveLeftUnit:=wdCharacter,Count:=1Selection.MoveRightUnit:=wdCharacter,Count:=1,Extend:=wdExtendEndSub16、统计修订的字数Subtest()DimRevAsRevision,c1AsLong,n1AsInteger,aAsStringDimWdAsRange,c2AsLong,n2AsInteger,bAsStringForEachRevInActiveDocument.RevisionsIfRev.Type=wdRevisionInsertThenForEachWdInRev.Range.Wordsc1=c1+IIf(WdLike"[一-龥]*",Wd.Characters.Count,1)Nextn1=n1+1a=a&Rev.Range.text&vbTabElseIfRev.Type=wdRevisionDeleteThenForEachWdInRev.Range.Wordsc2=c2+IIf(WdLike"[一-龥]*",Wd.Characters.Count,1)Nextn2=n2+1b=b&Rev.Range.text&vbTabEndIfNextMsgBox"增加内容"&n1&"处共"&c1&"字；删除内容"&n2&"处共"&c2&"字。"EndSub17、快速提取脚注内容Subtest()DimoFootNoteAsFootnote,myRangeAsRangeDimBeforeNameAsString,BeforeSizeAsSingleOnErrorResumeNextApplication.ScreenUpdating=FalseForEachoFootNoteInActiveDocument.FootnotesWithoFootNoteSetmyRange=ActiveDocument.Range(.Reference.Start,.Reference.End).Range.CopyWithmyRange.Text="(JZ:)"BeforeName=.Font.NameBeforeSize=.Font.SizemyRange.SetRange.Start+4,.Start+4.Paste.Font.Name=BeforeName.Font.Size=BeforeSizeEndWithEndWithNextApplication.ScreenUpdating=TrueEndSub 18、从任意页面编排页码Subtest()myPath="H:\temp\"Selection.HomeKeyUnit:=wdStorySetmyRange=Selection.Rangecurpage=0Application.ScreenUpdating=FalseDoprepage=curpagepagenum=pagenum+1SetmyRange=myRange.GoToNext(What:=wdGoToPage)curpage=myRange.Startendpage=myRange.Previous.StartIfcurpage=prepageThen_endpage=ActiveDocument.Content.EndActiveDocument.Range(prepage,endpage).CopyWithDocuments.Add.Content.Paste.SaveAsmyPath&"Page"&pagenum&".doc".CloseEndWithIfcurpage=prepageThenExitDoLoopApplication.ScreenUpdating=TrueEndSub  19、批量实现缩放打印  Subtest()Application.ScreenUpdating=FalseWithApplication.FileSearch.LookIn="h:\Downloads\temp5\".FileType=msoFileTypeWordDocumentsIf.Execute>0ThenFori=1To.FoundFiles.CountDocuments.OpenFileName:=.FoundFiles(i)ActiveDocument.PrintOutPrintZoomPaperWidth:=10433,PrintZoomPaperHeight:=14742ActiveDocument.CloseFalseNextiEndIfEndWithApplication.ScreenUpdating=TrueEndSub  20、对文档内容进行顺序排列  Submacro1()Dims()AsString,tempAsString,iAsLongVBAs=Split(ActiveDocument.Content,Chr(13)&Chr(13))Fori=0ToUBound(s)\2temp=s(i)s(i)=s(UBound(s)-i)s(UBound(s)-i)=tempNextDocuments.AddActiveDocument.Content.Text=Join(s,Chr(13)&Chr(13))EndSub21、替换Word文档插图的超链接Subtext()n=0ForEachsInActiveDocument.Shapess.SelectActiveDocument.Hyperlinks.AddAnchor:=Selection.ShapeRange,_Address:="http://www.sina.com"n=n+1NextMsgBox"共替换"&n&"个图片！"EndSub 22、为文档的每页添加固定内容  Subtest()DimmAsInteger,nAsPagem=Selection.Information(wdNumberOfPagesInDocument)Selection.HomeKeyUnit:=wdStoryForo=1TomWithSelection.TypeTextText:="机械制图国家标准".GoToNextwhat:=wdGoToPageEndWithNextEndSub23、批量实现图片的等比例缩  Subtest()DimShpAsShape,InlineShpAsInlineShapeDimBderAsBorderWithActiveDocumentForEachShpIn.ShapesShp.LockAspectRatio=msoTrueShp.Width=4*28.35NextForEachInlineShpIn.InlineShapesInlineShp.LockAspectRatio=msoTrueInlineShp.Width=4*28.35ForEachBderInInlineShp.BordersWithBder.LineStyle=wdLineStyleSingle.LineWidth=wdLineWidth050pt.Color=wdColorAutomaticEndWithNextNextEndWithEndSub  ‘上述代码中的“LockAspectRatio=msoTrue”表示锁定纵横比，如果不需要锁定纵横比，那么可以修改为“LockAspectRatio=msoFalse”。24、提取域代码Sub提取域代码()DimmyRangeAsRange,myCodesAsStringSetmyRange=Selection.RangeWithmyRangeIf.Fields.Count=0ThenMsgBox"您所选的内容中没有域代码!",vbInformationExitSubElse.Fields.Update.TextRetrievalMode.IncludeFieldCodes=True.TextRetrievalMode.IncludeHiddenText=TruemyCodes=.TextmyCodes=VBA.Replace(myCodes,Chr(19),"{")myCodes=VBA.Replace(myCodes,Chr(21),"}").SetRange.End,.End.InsertAftermyCodes'"注意,""{}""是由Ctrl+F9组合键自动插入的域标志!"&vbLf&"域代码:"&myCodes.Font.Name="Tahoma".Font.Size=11.CutEndIfEndWithEndSub25、'完美显示图片表格的普通视图Sub完美显示图片表格的普通视图()'此宏为雨雪霏霏特别奉献的小偏方，欢迎各位朋友测试。'如果文档中的嵌入式图片、表格显示迟滞、错位，运行此宏，将在普通视图下完美显示它们。ActiveDocument.PrintPreviewActiveDocument.ClosePrintPreviewActiveWindow.View.Type=wdNormalViewEndSub'26、完美显示图片表格的页面视图Sub完美显示图片表格的页面视图()'此宏为雨雪霏霏特别奉献的小偏方，欢迎各位朋友测试。'如果文档中的各种图片、表格显示迟滞、错位，运行此宏，将在页面视图下完美显示它们。ActiveDocument.PrintPreviewActiveDocument.ClosePrintPreviewActiveWindow.View.Type=wdNormalViewActiveWindow.View.Type=wdPrintViewEndSub'27、彻底删除页眉页脚Sub彻底删除页眉页脚()'此宏为雨雪霏霏试写。思路来自：'①konggs版主于2005-7-2620:38、2005-7-2708:51发表的帖子，'链接为http://club.excelhome.net/viewthread.php?tid=112178；'②守柔版主于2005-7-27年发表于站内的文章《Word中鲜为人知的三招》，'链接为http://www.excelhome.cn/Article/ShowArticle.asp?ArticleID=439。'此宏不足处在于：'①刪除页眉页脚后不能再恢复；'②本地文档进行删除操作后不保存退出的话，会在下次启动Word时出现文档恢复窗格。Dimw,yAsStringApplication.ScreenUpdating=FalseSetw=ActiveDocument.HTMLProject.HTMLProjectItems(2)IfActiveDocument.HTMLProject.HTMLProjectItems.Count=2ThenIfw.Name="header.htm"Thenw.Text=""ActiveDocument.HTMLProject.RefreshProjectActiveDocument.HTMLProject.RefreshDocumentIfActiveDocument.NameLike"*.doc"ThenMsgBox"本文档页眉页脚已彻底清除，请及时保存。"&Chr(13)&_"若退出本地文档时未保存，重新启动Word时将出现恢复窗格。",vbExclamation,"ExcelHome"ElseExitSubEndIfEndIfElseMsgBox"本文档当前未设置页眉页脚，不需要进行删除操作。",vbOKOnly,"ExcelHome"EndIfApplication.ScreenUpdating=TrueEndSub'28、切换纵横向页面Sub切换纵横向页面()'在"纵向页面"与"横向页面"间切换。IfActiveDocument.PageSetup.Orientation=wdOrientLandscapeThenActiveDocument.PageSetup.Orientation=wdOrientPortraitElseActiveDocument.PageSetup.Orientation=wdOrientLandscapeEndIfEndSubPAGE2