word常用宏

1.删除全文空白行由于空行的前面可能会有一些空白符号，经我观察，空白字符有6种：全角空格、半角空格、不间断空格、制表符、换行符、回车符，所以如果空白行中有这些东西的话，常规方法难以一下除去，故本过程将这些全部考虑在内。为了提高速度，只用一次替换完成。Sub删除全文空白行()Application.ScreenUpdating=Falset=TimerDimSAsRangeSetS=ActiveDocument.Content'S.Find.Execute^13[^t&ChrW(160)&^11^13]{1,},,,2,,,,,,^p,2SetS=NothingApplication.ScreenUpdating=TrueMsgBoxTimer-t‘消耗时间EndSub2.删除段落首位空白有时我们从网上下载网文，很多时候段落前后会有空白，其实最快的方法就是按Ctrl+E和Ctrl+J完成即可。用代码表示的话可以用Sendkeys来模拟按键，版块内有这样的帖子，然而个人感觉sendkeys方法不太可靠，因为我遇到过用了后有时会出现内容消失的情况。故想到直接去执行工具栏图标的方式完成：Sub去除段落首尾空格()CommandBars.FindControl(ID:=122).ExecuteCommandBars.FindControl(ID:=123).ExecuteEndSub这样便相当于按了一次居中和两端对齐的按钮。3.我的段落缩进这应该是我非常满意的作品了。花了我不少时间去反复改进，也是我目前应用最频繁的代码了。作用就是将选定范围的段落首位空格去掉，同时将选定范围的空行去除，若有标题则调整居中，正文格式则首行缩进2.Sub我的缩进()OnErrorResumeNextDimtAsSingle,paAsParagraph,spAsIntegerApplication.ScreenUpdating=Falset=TimerDimSAsRangesp=Selection.EndSetS=IIf(Selection.Type=wdSelectionIP,ActiveDocument.Content,Selection.Range)'经典选择语句！！！IfS=ActiveDocument.ContentThenAB=MsgBox(要进行全文缩进处理吗？,vbYesNoCancel+vbQuestion,全文处理判断)IfABvbYesThenExitSubEndIfS.SelectForEachpaInSelection.ParagraphsWithpa’从此处向下为对三级标题的设置，大家使用时可按自己喜好DIY。If.Style=(标题1)Then.Range.Font.Size=30.Range.Font.Bold=True.Range.Font.Name=华文行楷.Range.Font.Color=wdColorRed.Range.ParagraphFormat.Alignment=wdAlignParagraphCenterElseIf.Style=(标题2)Then.Range.Font.NameFarEast=华文隶书.Range.Font.NameAscii=Arial.Range.Font.Size=21.Range.ParagraphFormat.Alignment=wdAlignParagraphCenter.Range.Font.Color=wdColorRedElseIf.Style=(标题3)Then.Range.Font.Size=16.Range.Font.Bold=True.Range.Font.Color=wdColorBlue'.Range.Font.Name=华文新魏.Range.Font.Name=楷体_GB2312.Range.ParagraphFormat.Alignment=wdAlignParagraphCenterElseIf.Style=正文Then.Range.ParagraphFormat.CharacterUnitFirstLineIndent=2Else.Range.ParagraphFormat.CharacterUnitFirstLineIndent=2EndIfEndWithsp=0DoWhilepa.Range.Characters(1)Like[&Chr$(9)&ChrW(160)&ChrW(&H&0020)&ChrW(&H&E5E5)&Chr$(32)&]pa.Range.Characters(1)=sp=sp+1Ifsp100ThenExitDo'因为有的空格删之不去，加上这两句以防死循环！Looppa.Range.SelectIfLen(pa.Range)=1ThenGoToaaa:sp=0DoWhilepa.Range.Characters(pa.Range.Characters.Count-1)Like[&Chr$(9)&ChrW(160)&t16&ChrW(&H&0020)&ChrW(&H&E5E5)&Chr$(32)&]pa.Range.Characters(pa.Range.Characters.Count-1)=sp=sp+1Ifsp100ThenExitDoLoopaaa:IfLen(pa.Range)=1Thenpa.Range.DeleteS.SelectNextApplication.ScreenUpdating=TrueIfTimer-t5ThenMsgBox已完成！共消耗时间为：&Timer-tEndSub4.自动编号替换为手动编号，word自动编号可以为熟练掌握者在排版时提供很大的便利，而这种自作聪明的自动生成也会让不熟练者非常抓狂。因为自动的变化不容易控制。那么下面这段代码就将其自动转为手动编号，其实核心代码就是第四句。为了令其更规范，将其编号格式进一步替换成为半角点+空格的形式。Sub自动编号替换为手动编号()DimSAsRangeIfSelection.Type=wdSelectionIPThenSelection.ExpandwdParagraphSetS=Selection.RangeSelection.Range.ListFormat.ConvertNumbersToTextWithSelection.Find.ClearFormatting.Replacement.ClearFormatting.Text=([0-9]{1,})([.．、^9^32&ChrW(160)&ChrW(12288)&]{1,}).Wrap=0.Replacement.Text=\1.‘此处可改为顿号或其他.MatchWildcards=1.ExecuteReplace:=wdReplaceAllEndWithEndSub5.批量设定选定区域图片宽度，虽然网上也有类似的代码，但多是对全文进行的操作，而且只对一种有效。本方法适用于嵌入式和浮动式图片，而且仅对选定区域的有效不影响全文其他部分。Sub批量设定选定区域图片宽度()OnErrorResumeNextM=InputBox(请输入要调整图片的宽度：,厘米单位,14)*28.35IfSelection.Type=wdSelectionInlineShapeThenForn=1ToSelection.InlineShapes.Countpw=Selection.InlineShapes(n).Widthph=Selection.InlineShapes(n).HeightSelection.InlineShapes(n).Width=MSelection.InlineShapes(n).Height=ph*M/pwNextElseIfSelection.Type=wdSelectionShapeThenSelection.ShapeRange.Width=MElseIfSelection.Type=wdSelectionNormalThenSelection.Range.ShapeRange.Width=MForn=1ToSelection.Range.InlineShapes.Countpw=Selection.Range.InlineShapes(n).Widthph=Selection.Range.InlineShapes(n).HeightSelection.Range.InlineShapes(n).Width=MSelection.Range.InlineShapes(n).Height=ph*M/pw'11111NextEndIfEndSub6.每行插入表格n个图：这段代码也是我非常满意的代码之一。作用就是将选中的多个图像以表格+文件名的形式插入到文档中，而且自动根据每行插入的图像的个数来调整图像的比例大小。n为每行你要显示的图像数量。Sub每行插入表格n个图()OnErrorResumeNextApplication.ScreenUpdating=FalseDimDAsFileDialog,a,PAsInlineShape,tAsTableIfSelection.Information(wdWithInTable)=TrueThenMsgBox请将光标置于表格之外！:ExitSubWithApplication.FileDialog(msoFileDialogFilePicker).Title=请选择...If.Show=-1Thenn=InputBox(请输入表格的列数：,列数,3)M=.SelectedItems.CountDebug.Print共有&M&个图片;Mh=IIf(M/n=Int(M/n),2*M/n,2*(Int(M/n)+1))Sett=ActiveDocument.Tables.Add(Selection.Range,h,n)t.Borders.Enable=Truet.Borders.OutsideLineStyle=wdLineStyleDoubleForEachaIn.SelectedItemsB=Split(a,\)(UBound(Split(a,\)))C=Split(B,.)(0)SetP=Selection.InlineShapes.AddPicture(FileName:=a,SaveWithDocument:=True)WithPw=.Width.Width=Int(410/n).Height=.Width*.Height/wEndWithi=i+1Selection.MoveLeftwdCharacter,1Selection.MoveDownwdLine,1Selection.TypeTextCSelection.Cells(1).SelectSelection.ParagraphFormat.Alignment=wdAlignParagraphCenter'决定了首行居中Selection.HomeKeySelection.MoveDownwdLine,-1Selection.MoveRightwdCharacter,2Debug.Printi,nIfi=Val(n)ThenSelection.MoveRightwdCharacter,1Selection.Cells(1).SelectSelection.EndKeySelection.MoveDownwdLine,1i=0EndIfNextEndIfEndWithApplication.ScreenUpdating=TrueEndSub7.表格行列转置代码，本代码能够实现表格行变成列，列变成行，也就是翻转90度吧，论坛有类似的代码，但本代码的特点在于加入原来表格有格式的话，比如颜色，再转置后能保留格式不丢失。Sub表格行列转置()OnErrorResumeNextDimaAsTable,BAsTableSeta=Selection.Tables(1)Debu