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