常用WORDVBA代码.docx
- 文档编号:12019714
- 上传时间:2023-04-16
- 格式:DOCX
- 页数:10
- 大小:16.39KB
常用WORDVBA代码.docx
《常用WORDVBA代码.docx》由会员分享,可在线阅读,更多相关《常用WORDVBA代码.docx(10页珍藏版)》请在冰豆网上搜索。
常用WORDVBA代码
有用的WORDVBA代码
1、删除空格
'*+++++++++++++++++++++++++++++++++++++++
'功能简介:
删除空格'
'*----------------------------------------
Sub删除空格()
DimFindCharAsString,FcountAsInteger,RepCharAsString
OnErrorResumeNext
Application.ScreenUpdating=False'关闭屏幕更新
FindChar=""
RepChar=""
WithActiveDocument.Content.Find'此处针对全文档
DoWhile.Execute(findtext:
=FindChar)=True'如果发现
Fcount=Fcount+1'计数器
Loop
IfMsgBox("文档中共发现了"&Fcount&"个"&FindChar&vbCrLf_
&",按Yes键将进行下一步的替换工作,按No取消",vbYesNo+vbInformation)=vbYesThen
.Executefindtext:
=FindChar,Wrap:
=wdFindContinue,replacewith:
=RepChar,Replace:
=wdReplaceAll
EndIf
EndWith
Application.ScreenUpdating=True
'恢复屏幕更新
EndSub
2、段首空格删除
第一种
'*+++++++++++++++++++++++++++++++++++++++
'功能简介:
删除段首空格'
'*-----------------------------------------
Sub删除段首空格1()
Selection.WholeStory'CTR+A
Selection.ParagraphFormat.Alignment=wdAlignParagraphCenter'CTR+E
Selection.ParagraphFormat.Reset'CTR+Q
EndSub
第二种
'*+++++++++++++++++++++++++++++++++++++++
'功能简介:
删除段首空格'
'*----------------------------------------
Sub删除段首空格2()
DimiAsParagraph,nAsLong
Application.ScreenUpdating=False'关闭屏幕刷新
ForEachiInActiveDocument.Paragraphs'在活动文档的段落集合中循环
Forn=1Toi.Range.Characters.Count
Ifi.RangeLike"*"_
Ori.RangeLike" *"Then
i.Range.Characters
(1).Delete
Else:
ExitFor
EndIf
Nextn
Next
Application.ScreenUpdating=True'恢复屏幕刷新
EndSub
第三种
'*+++++++++++++++++++++++++++++++++++++++
'功能简介:
删除段首空格'
'*----------------------------------------
Sub删除段首空格3()
DimiAsParagraph,nAsLong
Application.ScreenUpdating=False'关闭屏幕刷新
ForEachiInActiveDocument.Paragraphs'在活动文档的段落集合中循环
Forn=1Toi.Range.Characters.Count
Ifi.Range.Characters
(1).Text=""_
Ori.Range.Characters
(1).Text=" "Then
i.Range.Characters
(1).Delete
Else:
ExitFor
EndIf
Nextn
Next
Application.ScreenUpdating=True'恢复屏幕刷新
EndSub
3、删除空白段落
'功能简介:
可以对指定长度的段落进行删除,当LEN=1时
'可对空白段落进行删除。
'
'*---------------------------------------
Sub删除空段()
DimiAsParagraph,nAsLong
Call删除段首空格2'调用工程
Application.ScreenUpdating=False'关闭屏幕刷新
ForEachiInActiveDocument.Paragraphs'在活动文档的段落集合中循环
IfLen(i.Range)=1Then'判断段落长段,此处可根据文档实际情况
i.Range.Delete'进行必要的修改可将任意长度段落删除
n=n+1'计数
EndIf
Next
MsgBox"共删除空白段落"&n&"个!
"
Application.ScreenUpdating=True'恢复屏幕刷新
EndSub
4、设置段落格式
'*+++++++++++++++++++++++++++++++++++++++
'功能简介:
设置段落格式'
'*----------------------------------------
Sub设置段落格式()
DimpaAsParagraph
OnErrorResumeNext
Application.ScreenUpdating=False'关闭屏幕更新
ForEachpaInActiveDocument.Paragraphs
pa.Format.CharacterUnitFirstLineIndent=2
Next
WithActiveDocument.Content.Font
.Name="楷体"
.Size=14
EndWith
Application.ScreenUpdating=True'恢复屏幕更新
EndSub
5、设置大纲级别
第一种
'*+++++++++++++++++++++++++++++++++++++++
'实现以日期2010开头的段落,第一句加粗的代码,
'并将该段落升为一级大纲。
'
'*----------------------------------------
Sub设置大纲1()
OnErrorResumeNext
Application.ScreenUpdating=False'关闭屏幕更新
ForRQJC=1ToActiveDocument.Range(0,ActiveDocument.Range.End).Paragraphs.Count'对正文全文段落进行循环
WithActiveDocument.Paragraphs(RQJC).Range
IfActiveDocument.Range(.Start,.Start+4).Text="2010"Then'当每一段落前四个字符以“2010”开头
.Sentences
(1).Font.Bold=True'每一段第一句字体加粗
ActiveDocument.Paragraphs(RQJC).OutlineLevel=wdOutlineLevel1'该段落的大纲级别变为一级大纲
EndIf
EndWith
NextRQJC
Application.ScreenUpdating=True'恢复屏幕更新
EndSub
第二种
'*+++++++++++++++++++++++++++++++++++++++
'字符数小于41的段落,第一句加粗,
'并将该段落升为二级大纲。
'
'*-------------------------------------------
Sub设置大纲2()
DimnAsLong,iAsParagraph
OnErrorResumeNext
Application.ScreenUpdating=False'关闭屏幕更新
Forn=1ToActiveDocument.Paragraphs.Count
IfActiveDocument.Paragraphs(n).Range.Characters.Count<41_
AndActiveDocument.Paragraphs(n).Range.Characters.Count>0Then'段落字符数小于41,约为一两行
ActiveDocument.Paragraphs(n).Range.Sentences.First.Font.Bold=True'每一段第一句字体加粗
ActiveDocument.Paragraphs(n).OutlineLevel=wdOutlineLevel2'该段落的大纲级别变为二级大纲
EndIf
Nextn
Application.ScreenUpdating=True'恢复屏幕更新
EndSub
第三种
'*+++++++++++++++++++++++++++++++++++++++
'以数字开头的段落,第一句加粗,
'并将该段落升为二、三级大纲。
'
'*------------------------------------------
Sub设置大纲3()
DimpaAsParagraph,MyStr1AsString,MyStr2AsString,MyStr3AsString
OnErrorResumeNext
Application.ScreenUpdating=False'关闭屏幕更新
Call删除段首空格3'调用工程
MyStr1="第一二三四五六七八九十"'假定为手动加注每个段落开头为中文大写数字
MyStr2="123456789"'假定为手动加注每个段落开头为数字,半角
MyStr3="123456789"'假定为手动加注每个段落开头为数字,全角
ForEachpaInActiveDocument.Paragraphs
IfInStr(MyStr1,ActiveDocument.Range(pa.Range.Start,pa.Range.Start+1).Text)>0Then
pa.Range.Sentences.First.Font.Bold=True'每一段第一句字体加粗
pa.OutlineLevel=wdOutlineLevel2'该段落的大纲级别变为二级大纲
EndIf
IfInStr(MyStr2,ActiveDocument.Range(pa.Range.Start,pa.Range.Start+1).Text)>0Then
pa.Range.Sentences.First.Font.Bold=True'每一段第一句字体加粗
pa.OutlineLevel=wdOutlineLevel3'该段落的大纲级别变为三级大纲
EndIf
IfInStr(MyStr3,ActiveDocument.Range(pa.Range.Start,pa.Range.Start+1).Text)>0Then
pa.Range.Sentences.First.Font.Bold=True'每一段第一句字体加粗
pa.OutlineLevel=wdOutlineLevel3'该段落的大纲级别变为三级大纲
EndIf
Next
Application.ScreenUpdating=True'恢复屏幕更新
EndSub
第四种
'*+++++++++++++++++++++++++++++++++++++++
'以"第#"开头的段落,第一句加粗,
'并将该段落升为二级大纲。
'
'*------------------------------------------
Sub设置大纲4()
DimpaAsParagraph,MyStr1AsString
OnErrorResumeNext
Application.ScreenUpdating=False'关闭屏幕更新
Call删除段首空格3'调用工程
MyStr1="一二三四五六七八九十"'假定为手动加注每个段落开头为中文大写数字
ForEachpaInActiveDocument.Paragraphs
Ifpa.Range.Characters.First.Text="第"Then
IfInStr(MyStr1,ActiveDocument.Range(pa.Range.Start+1,pa.Range.Start+2).Text)>0Then
pa.Range.Sentences.First.Font.Bold=True'每一段第一句字体加粗
pa.OutlineLevel=wdOutlineLevel2'该段落的大纲级别变为二级大纲
EndIf
EndIf
Next
Application.ScreenUpdating=True'恢复屏幕更新
EndSub
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 常用 WORDVBA 代码