常用WORD-VBA代码

有用的WORDVBA代码1、删除空格'*+++++++++++++++++++++++++++++++++++++++'功能简介:删除空格''*----------------------------------------Sub删除空格()DimFindCharAsString,FcountAsInteger,RepCharAsStringOnErrorResumeNextApplication.ScreenUpdating=False'关闭屏幕更新FindChar=RepChar=WithActiveDocument.Content.Find'此处针对全文档DoWhile.Execute(findtext:=FindChar)=True'如果发现Fcount=Fcount+1'计数器LoopIfMsgBox(文档中共发现了&Fcount&个&FindChar&vbCrLf_&,按Yes键将进行下一步的替换工作,按No取消,vbYesNo+vbInformation)=vbYesThen.Executefindtext:=FindChar,Wrap:=wdFindContinue,replacewith:=RepChar,Replace:=wdReplaceAllEndIfEndWithApplication.ScreenUpdating=True'恢复屏幕更新EndSub2、段首空格删除第一种'*+++++++++++++++++++++++++++++++++++++++'功能简介:删除段首空格''*-----------------------------------------Sub删除段首空格1()Selection.WholeStory'CTR+ASelection.ParagraphFormat.Alignment=wdAlignParagraphCenter'CTR+ESelection.ParagraphFormat.Reset'CTR+QEndSub第二种'*+++++++++++++++++++++++++++++++++++++++'功能简介:删除段首空格''*----------------------------------------Sub删除段首空格2()DimiAsParagraph,nAsLongApplication.ScreenUpdating=False'关闭屏幕刷新ForEachiInActiveDocument.Paragraphs'在活动文档的段落集合中循环Forn=1Toi.Range.Characters.CountIfi.RangeLike*_Ori.RangeLike*Theni.Range.Characters(1).DeleteElse:ExitForEndIfNextnNextApplication.ScreenUpdating=True'恢复屏幕刷新EndSub第三种'*+++++++++++++++++++++++++++++++++++++++'功能简介:删除段首空格''*----------------------------------------Sub删除段首空格3()DimiAsParagraph,nAsLongApplication.ScreenUpdating=False'关闭屏幕刷新ForEachiInActiveDocument.Paragraphs'在活动文档的段落集合中循环Forn=1Toi.Range.Characters.CountIfi.Range.Characters(1).Text=_Ori.Range.Characters(1).Text=Theni.Range.Characters(1).DeleteElse:ExitForEndIfNextnNextApplication.ScreenUpdating=True'恢复屏幕刷新EndSub3、删除空白段落'功能简介:可以对指定长度的段落进行删除，当LEN=1时'可对空白段落进行删除。''*---------------------------------------Sub删除空段()DimiAsParagraph,nAsLongCall删除段首空格2'调用工程Application.ScreenUpdating=False'关闭屏幕刷新ForEachiInActiveDocument.Paragraphs'在活动文档的段落集合中循环IfLen(i.Range)=1Then'判断段落长段,此处可根据文档实际情况i.Range.Delete'进行必要的修改可将任意长度段落删除n=n+1'计数EndIfNextMsgBox共删除空白段落&n&个!Application.ScreenUpdating=True'恢复屏幕刷新EndSub4、设置段落格式'*+++++++++++++++++++++++++++++++++++++++'功能简介:设置段落格式''*----------------------------------------Sub设置段落格式()DimpaAsParagraphOnErrorResumeNextApplication.ScreenUpdating=False'关闭屏幕更新ForEachpaInActiveDocument.Paragraphspa.Format.CharacterUnitFirstLineIndent=2NextWithActiveDocument.Content.Font.Name=楷体_GB2312.Size=14EndWithApplication.ScreenUpdating=True'恢复屏幕更新EndSub5、设置大纲级别第一种'*+++++++++++++++++++++++++++++++++++++++'实现以日期2010开头的段落，第一句加粗的代码，'并将该段落升为一级大纲。''*----------------------------------------Sub设置大纲1()OnErrorResumeNextApplication.ScreenUpdating=False'关闭屏幕更新ForRQJC=1ToActiveDocument.Range(0,ActiveDocument.Range.End).Paragraphs.Count'对正文全文段落进行循环WithActiveDocument.Paragraphs(RQJC).RangeIfActiveDocument.Range(.Start,.Start+4).Text=2010Then'当每一段落前四个字符以“2010”开头.Sentences(1).Font.Bold=True'每一段第一句字体加粗ActiveDocument.Paragraphs(RQJC).OutlineLevel=wdOutlineLevel1'该段落的大纲级别变为一级大纲EndIfEndWithNextRQJCApplication.ScreenUpdating=True'恢复屏幕更新EndSub第二种'*+++++++++++++++++++++++++++++++++++++++'字符数小于41的段落，第一句加粗，'并将该段落升为二级大纲。''*-------------------------------------------Sub设置大纲2()DimnAsLong,iAsParagraphOnErrorResumeNextApplication.ScreenUpdating=False'关闭屏幕更新Forn=1ToActiveDocument.Paragraphs.CountIfActiveDocument.Paragraphs(n).Range.Characters.Count41_AndActiveDocument.Paragraphs(n).Range.Characters.Count0Then'段落字符数小于41,约为一两行ActiveDocument.Paragraphs(n).Range.Sentences.First.Font.Bold=True'每一段第一句字体加粗ActiveDocument.Paragraphs(n).OutlineLevel=wdOutlineLevel2'该段落的大纲级别变为二级大纲EndIfNextnApplication.ScreenUpdating=True'恢复屏幕更新EndSub第三种'*+++++++++++++++++++++++++++++++++++++++'以数字开头的段落，第一句加粗，'并将该段落升为二、三级大纲。''*------------------------------------------Sub设置大纲3()DimpaAsParagraph,MyStr1AsString,MyStr2AsString,MyStr3AsStringOnErrorResumeNextApplication.ScreenUpdating=False'关闭屏幕更新Call删除段首空格3'调用工程MyStr1=第一二三四五六七八九十'假定为手动加注每个段落开头为中文大写数字MyStr2=123456789'假定为手动加注每个段落开头为数字，半角MyStr3=１２３４５６７８９'假定为手动加注每个段落开头为数字，全角ForEachpaInActiveDocument.ParagraphsIfInStr(MyStr1,ActiveDocument.Range(pa.Range.Start,pa.Range.Start+1).Text)0Thenpa.Range.Sentences.First.Font.Bold=True'每一段第一句字体加粗pa.OutlineLevel=wdOutlineLevel2'该段落的大纲级别变为二级大纲EndIfIfInStr(MyStr2,ActiveDocument.Range(pa.Range.Start,pa.Range.Start+1).Text)0Thenpa.Range.Sentences.First.Font.Bold=True'每一段第一句字体加粗pa.OutlineLevel=wdOutlineLevel3'该段落的大纲级别变为三级大纲EndIfIfInStr(MyStr3,ActiveDocument.Range(pa.Range.Start,pa.Range.Start+1).Text)0Thenpa.Range.Sentences.First.Font.Bold=True'每一段第一句字体加粗pa.OutlineLevel=wdOutlineLevel3'该段落的大纲级别变为三级大纲EndIfNextApplication.ScreenUpdating=True'恢复屏幕更新EndSub第四种'*+++++++++++++++++++++++++++++++++++++++'以第#开头的段落，第一句加粗，'并将该段落升为二级大纲。''*------------------------------------------Sub设置大纲4()DimpaAsParagraph,MyStr1AsStringOnErrorResumeNextApplication.ScreenUpdating=False'关闭屏幕更新Call删除段首空格3'调用工程MyStr1=一二三四五六七八九十'假定为手动加注每个段落开头为中文大写数字ForEachpaInActiveDocument.ParagraphsIfpa.Range.Characters.First.Text=第ThenIfInStr(MyStr1,ActiveDocument.Range(pa.Range.Start+1,pa.Range.Start+2).Text)0Thenpa.Range.Sent