Word Excel vba代码备忘录.docx
《Word Excel vba代码备忘录.docx》由会员分享，可在线阅读，更多相关《Word Excel vba代码备忘录.docx（86页珍藏版）》请在冰点文库上搜索。
WordExcelvba代码备忘录
通配符使用2
选择性地去掉段落标记3
Like运算符的语法3
语句：
光标运动，改变选区4
Sub用属性的标题更改选定目录下的office文档文件名（）6
'64卦卦辞输出到数组7
换行符（vbLf）和回车符（vbCr）有什么区别？
8
查找数字后面跟“卦”字，在数字前添加第，在“卦”后面添加冒号8
关于range的find，和selection的find，9
判断当前行是否有分页符9
两段文字之间区域删除dountil未控制死循环10
两段文字之间区域删除range（range1,range2）和for……next循环10
两段文字之间区域删除查找扩展选区for……next循环11
查找特定字符开头结尾（"[[]*[]]*"）的段落，删除其后部分12
删除空段落13
选择性粘贴13
文档中的编号变成标题13
如何选中每段的一部分，并把这部分复制到另一个文件中？
13
本示例交替设置活动文档中的所有段落为“标题3”和“正文”样式。
14
新概念3标题整理15
本示例显示活动文档中每个段落的样式。
15
妙用VisualBasic将Word替换进行到底15
删除特定开头结尾的段落17
以下代码可选定两个【例子】之间的内容17
插入一个图片，将插入的图片的格式设置为浮于文字的上方。
18
当前光标是否处于文章的末尾，光标在文档中的位置（字符计数），18
如何实现VBA中窗体控件中的复合框控件的下拉菜单中选择数据？
而且数据来源与相连接的Excel表中？
18
Int（（上限-下限+1）*Rnd+下限）18
WORDVBA指定任意页为当前页19
Word自动翻页19
Sub清除剪贴板（）19
在文档中显示当前文档的属性，并弹出文档属性的标题20
BuiltInDocumentProperties属性20
当您尝试使用VBA更改文档属性时出现运行时错误4248、4605或594121
若要列出某个文件夹中的所有文件WD2002：
示例宏23
两个宏使用MicrosoftWord文档的页或节属性选择并移动到文档内容26
重命名文件28
打开目录下文件28
读取一个文件夹下的所有文件,也可以根据扩展名筛选29
新建一篇文档，并显示“另存为”对话框，为文档提供一个名称。
29
显示各打开文档的名称。
29
新建一个文件并且写入内容另存，再关闭30
查找替换功能就能实现word宏替换数字和文字之间的空格30
WordVBA语句--------------------30
Application对象30
Documents/Document对象31
Paragraphs/Paragraph对象32
Sentences对象32
Words对象33
Characters对象33
Sections/Section对象33
Range对象33
其它34
将A1到A10的数据写到数组里34
Excel语句集400句34
定制模块行为34
工作簿35
工作表35
单元格/单元格区域36
公式与函数37
图表38
窗体38
事件39
对象39
工作簿40
工作表40
公式与函数41
图表42
窗体和控件42
对象43
Application对象43
Range对象44
Collection与object45
WindowsAPI45
8位数
利用循环，先找到.后面跟数字，选中小数点点前面的字符，判断是否数字，如果是，i加1（初始＝0）得到小数点前面的位数为A
再找小数点后面的数字个数为B，如果A＋B>=8，光标定位在小数点上，向后移动8－A次，删除后面的数字（A+B-8）个
通配符使用
[^i^13^32^t]{2,}替换任意2个以上相邻的软回车、硬回车、空格或者制表符为硬回车
（<[!
^13]*^13）（*）\1\1\2删除重复段落，重复直到删除完所有的重复段落
*[^13^l]使用通配符格式非隐藏查找并复制这些，再在特殊格式文字上右键选相似文字删除之
选择性地去掉段落标记
Sub标记词（）
Selection.InsertAfter"标记词"
EndSub
Sub去除段落标记（）
Application.ScreenUpdating=False
WithSelection
.HomeKeyUnit:
=wdStory
.Find.Executefindtext:
="^p",replacewith:
="",Replace:
=wdReplaceAll,Wrap:
=wdFindContinue
.Find.Executefindtext:
="标记词",replacewith:
="^p",Replace:
=wdReplaceAll,Wrap:
=wdFindContinue
Application.ScreenUpdating=True
EndWith
EndSub
Like运算符的语法
Like运算符用于判断给定的字符串是否与指定的模式相匹配，其语法为：
结果=<字符串>Like<模式>
说明：
（1）<字符串>为文本字符串或者对包含文本字符串的单元格的引用，是要与<模式>相比较的字符串，数据类型为String型。
<模式>数据类型为String型，字符串中可以使用一些特殊字符，其它的字符都能与它们相匹配，其如下表1所示。
<模式>的字符与<字符串>匹配的文本
？
任意单个字符
*零或者多个字符
#任意单个数字（0-9）
[charlist]字符列表中的任意单个字符
[!
charlist]不在字符列表中的任意单个字符
[]空字符串（““）
（2）<结果>为Boolean型。
如果字符串与指定的模式相匹配，则<结果>为True；否则<结果>为False。
如果字符串或者模式Null，则结果为Null。
（3）Like运算符缺省的比较模式为二进制，因此区分大小写。
可以用OptionCompare语句来改变比较模式，如改变为文本比较模式，则不区分大小写。
（4）[Charlist]将模式中的一组字符与字符串中的一个字符进行匹配，可以包含任何一种字符，包括数字；在[Charlist]中使用连字号（-）产生一组字符来与字符串中的一个字符相匹配，如[A-D]与字符串相应位置的A、B、C或D匹配；在[Charlist]中可以产生多组字符，如[A-DH-J]；各组字符必须是按照排列顺序出现的；在Charlist的开头或结尾使用连字号（-）与连字号自身相匹配，例如[-H-N]与连字号（-）或H到N之间的任何字符相匹配。
在Charlist中的一个字符或者一组字符前加上！
号，表明与该字符或该组字符之外的所有字符匹配，如[！
H-N]与字符H-N范围之外的所有字符匹配；而在[]外使用！
号则只匹配其自身。
要使用任何特殊字符作为匹配字符，只需将它放在[]中即可，例如[？
]表明要与一个问号进行匹配。
为了与左括号（[）、问号（?
）、数字符号（#）和星号（*）等特殊字符进行匹配，可以将它们用方括号括起来。
不能在一个组内使用右括号（]）与自身匹配，但在组外可以作为个别字符使用。
语句：
光标运动，改变选区
移动光标至文档开始
Selection.HomeKeyunit:
=wdStory
下面的供参考:
SubMoveToCurrentLineStart（）
'移动光标至当前行首
Selection.HomeKeyunit:
=wdLine
EndSub
SubMoveToCurrentLineEnd（）
'移动光标至当前行尾
Selection.EndKeyunit:
=wdLine
EndSub
SubSelectToCurrentLineStart（）
'选择从光标至当前行首的内容
Selection.HomeKeyunit:
=wdLine,Extend:
=wdExtend
EndSub
SubSelectToCurrentLineEnd（）
'选择从光标至当前行尾的内容
Selection.EndKeyunit:
=wdLine,Extend:
=wdExtend
EndSub
SubSelectCurrentLine（）
'选择当前行
Selection.HomeKeyunit:
=wdLine
Selection.EndKeyunit:
=wdLine,Extend:
=wdExtend
EndSub
SubMoveToDocStart（）
'移动光标至文档开始
Selection.HomeKeyunit:
=wdStory
EndSub
SubMoveToDocEnd（）
'移动光标至文档结尾
Selection.EndKeyunit:
=wdStory
EndSub
SubSelectToDocStart（）
'选择从光标至文档开始的内容
Selection.HomeKeyunit:
=wdStory,Extend:
=wdExtend
EndSub
SubSelectToDocEnd（）
'选择从光标至文档结尾的内容
Selection.EndKeyunit:
=wdStory,Extend:
=wdExtend
EndSub
SubSelectDocAll（）
'选择文档全部内容（从WholeStory可猜出Story应是当前文档的意思）
Selection.WholeStory
EndSub
SubMoveToCurrentParagraphStart（）
'移动光标至当前段落的开始
Selection.MoveUpunit:
=wdParagraph
EndSub
SubMoveToCurrentParagraphEnd（）
'移动光标至当前段落的结尾
Selection.MoveDownunit:
=wdParagraph
EndSub
SubSelectToCurrentParagraphStart（）
'选择从光标至当前段落开始的内容
Selection.MoveUpunit:
=wdParagraph,Extend:
=wdExtend
EndSub
SubSelectToCurrentParagraphEnd（）
'选择从光标至当前段落结尾的内容
Selection.MoveDownunit:
=wdParagraph,Extend:
=wdExtend
EndSub
SubSelectCurrentParagraph（）
'选择光标所在段落的内容
Selection.MoveUpunit:
=wdParagraph
Selection.MoveDownunit:
=wdParagraph,Extend:
=wdExtend
EndSub
SubDisplaySelectionStartAndEnd（）
'显示选择区的开始与结束的位置，注意：
文档第1个字符的位置是0
MsgBox（"第"&Selection.Start&"个字符至第"&Selection.End&"个字符"）
EndSub
SubDeleteCurrentLine（）
'删除当前行
Selection.HomeKeyunit:
=wdLine
Selection.EndKeyunit:
=wdLine,Extend:
=wdExtend
Selection.Delete
EndSub
SubDeleteCurrentParagraph（）
'删除当前段落
Selection.MoveUpunit:
=wdParagraph
Selection.MoveDownunit:
=wdParagraph,Extend:
=wdExtend
Selection.Delete
EndSub
Sub用属性的标题更改选定目录下的office文档文件名（）
DimxAsString,MyNameAsString
DimiAsInteger
DimResponseAsInteger,TotalFilesAsInteger
OnErrorResumeNext
Folder:
'提示输入目录
x=InputBox（Prompt:
="请添加要改名文件所在目录"&vbCr&vbCr_
&"Forexample:
C:
\MyDocuments",_
Default:
=Options.DefaultFilePath（wdDocumentsPath））
Ifx=""Orx=""Then
IfMsgBox（"Eitheryoudidnottypeafoldernamecorrectly"_
&vbCr&"oryouclickedCancel.Doyouwanttoquit?
"_
&vbCr&vbCr&_
"Ifyouwanttotypeafoldername,clickNo."&vbCr&_
"Ifyouwanttoquit,clickYes.",vbYesNo）=vbYesThen
ExitSub
Else
GoToFolder
EndIf
EndIf
'Testiffolderexists.
IfDir（x,vbDirectory）=""Then
MsgBox"Thefolderdoesnotexist.Pleasetryagain."
GoToFolder
EndIf
'Searchthespecifiedfolderforfiles
'andtypethelistinginthedocument.
WithApplication.FileSearch
.NewSearch
.FileType=msoFileTypeOfficeFiles
'Changethe.FileTypetothetypeoffilesyouarelookingfor;
'forexample,thefollowinglinefindsallfiles:
'.FileType=msoFileTypeAllFiles
.LookIn=x
.Execute
TotalFiles=.FoundFiles.Count
IfTotalFiles=0Then
MsgBox（"Therearenofilesinthefolder!
"&_
"Pleasetypeanotherfoldertolist."）
GoToFolder
EndIf
'MsgBoxx
Fori=1ToTotalFiles
j=.FoundFiles（i）
Documents.Openj
j.Active
Title=x&"\"&ActiveDocument.BuiltInDocumentProperties（"Title"）&".doc"
MsgBox"文件即将更名为：
"&Title
ActiveDocument.SaveAsTitle
ActiveDocument.Close
Nexti
EndWith
EndSub
'64卦卦辞输出到数组
DimGuaCi（63,2）AsString
Documents（"1.doc"）.Activate‘1.doc必须先打开，并且把卦辞粘贴进去
Setmydoc=ActiveDocument
Setguacishuzu=Documents.Add
mydoc.Activate
WithSelection
.HomeKeyunit:
=wdStory
Fori=0To63
If.Find.Execute（findtext:
="第"&i&"卦",Forward:
=True,Wrap:
=wdFindContinue）=TrueThen
.MoveDownunit:
=wdParagraph,Count:
=1,Extend:
=wdExtend
.MoveLeftunit:
=wdCharacter,Count:
=1,Extend:
=wdExtend
GuaCi（i,0）=.Text'输出本卦卦象第一部分
'MsgBoxGuaCi（i,0）
.MoveDownunit:
=wdParagraph,Count:
=1
.MoveDownunit:
=wdParagraph,Count:
=1,Extend:
=wdExtend
.MoveLeftunit:
=wdCharacter,Count:
=1,Extend:
=wdExtend
GuaCi（i,1）=.Text
'MsgBoxGuaCi（i,1）
.MoveDownunit:
=wdParagraph,Count:
=1
.MoveDownunit:
=wdParagraph,Count:
=1,Extend:
=wdExtend
.MoveLeftunit:
=wdCharacter,Count:
=1,Extend:
=wdExtend
GuaCi（i,2）=.Text
'MsgBoxGuaCi（i,2）
guacishuzu.Content.InsertAfter"ZongGuaCi（"&i&"）="&Chr（34）&GuaCi（i,0）&Chr（34）&"&"&"Vbcr"&"&"&Chr（34）&GuaCi（i,1）&Chr（34）&"&"&"Vbcr"&"&"&Chr（34）&GuaCi（i,2）&Chr（34）&vbCr
EndIf
Next
EndWith
EndSub
换行符（vbLf）和回车符（vbCr）有什么区别？
在DOS时代，这两个字符是有各自的分工。
CR使光标回到行首，LF使光标下移一行。
不过在WINDOWS里面，基本只要有CR就可以了，就是说CR兼备了LF的功能。
而LF则变得可有可无，只在一些终端界面例如TELNET里面才能起到作用。
以前的提法是"软回车"和"硬回车".
如果要印象深刻一点,就打开记事本或Word,打几行文字,"自动换行"和"回车换行"就是,前者是lf,后者是CR（CrLf）.
Cr表示命令结束，提交
Lf表示换行（移到下一行的开始）
应该用vbCrLf才标准
查找数字后面跟“卦”字，在数字前添加第，在“卦”后面添加冒号
Subadd（）
WithSelection
.Find.ClearFormatting
With.Find
.Forward=True
.Wrap=wdFindStop
.Format=False
.MatchWildcards=False
.MatchAllWordForms=False
EndWith
.HomeKeyunit:
=wdStory'光标定位到文档开头
ForEachparaInActiveDocument.Paragraphs
If.Find.Execute（findtext:
="^#卦"）=TrueThen
Setmyrange=.Range
.MoveUpunit:
=wdParagraph,Count:
=1
.InsertAfter"第"
myrange.Select
.InsertAfter"：
"
.MoveDownunit:
=wdParagraph
EndIf
Nextpara
EndWith
EndSub
关于range的find，和selection的find，
前者的find对选区没有改变，但是改变了range的值，使range变成find的内容。
Subrange的find对于range和选区的影响（）
DimMyRangeAsrange,YouRangeAsrange
i=1
Fori=1To3
SetMyRange=ActiveDocument.Paragraphs（i）.range
SetYourRange=ActiveDocument.Paragraphs（i）.range
IfMyRange.Find.Execute（FindText:
="参考译文"）=TrueThen'选区还是最初状态
MyRange.Select'选区变成“参考译文”
MsgBox"range被改成FindText的内容"
YourRange.Select'选区变成ActiveDocument.Paragraphs（i）.Range
MsgBox"查找之前的range"
Else:
MsgBox"notfound"
EndIf
Nexti
EndSub
判断当前行是否有分页符
SubDelBlanka1（）
DimMyRangeAsRange,SelStartAsLong,SelEndAsLong,StSelAsRange
OnErrorResumeNext
Application.ScreenUpdating=False
WithSelection
SetStSel=.Range
SelStart=.Start
.MoveDown'下移一行
SelEnd=.Start+1
SetMyRange=ActiveDocument.Range（SelStart,SelEnd）
IfMyRangeLike"*"&Chr（13）=TrueAndMyRange.Find.Execute（FindText:
="^m"）=TrueThenMsgBox"当前行中有手动分页符!
"
StSel.Select
EndWith
Application.ScreenUpdating=True
EndSub
两段文字之间区域删除dountil未控制死循环
Sub两段文字之间区域删除alt1（）
DimMyRangeAsRange,YourangeAsRange,SelSt
升级会员 