ExcelVBA编程的常用代码.docx
《ExcelVBA编程的常用代码.docx》由会员分享，可在线阅读，更多相关《ExcelVBA编程的常用代码.docx（32页珍藏版）》请在冰豆网上搜索。
ExcelVBA编程的常用代码
ExcelVBA编程的常用代码
用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！
使用Dim语句
Dimaasinteger'声明a为整型变量
Dima'声明a为变体变量
Dimaasstring'声明a为字符串变量
Dimaascurrency,bascurrency,cascurrency'声明a,b,c为货币变量
......
声明变量可以是：
Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal〔当前不支持〕、Date、String〔只限变长字符串〕、String*length〔定长字符串〕、Object、Variant、用户定义类型或对象类型。
强制声明变量
OptionExplicit
说明：
该语句必在任何过程之前出现在模块中。
声明常数
用来代替文字值。
Const
'常数的默认状态是Private。
ConstMy=456
'声明Public常数。
PublicConstMyString="HELP"
'声明PrivateInteger常数。
PrivateConstMyIntAsInteger=5
'在同一行里声明多个常数。
ConstMyStr="Hello",MyDoubleAsDouble=3.4567
选择当前单元格所在区域
在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。
只要将该段代码参加到你的模块中。
SubMy_Select
Selection.CurrentRegion.Select
Endsub
返回当前单元格中数据删除前后空格后的值
submy_trim
msgboxTrim（ActiveCell.Value）
endsub
单元格位移
submy_offset
ActiveCell.Offset（0,1）.Select'当前单元格向左移动一格
ActiveCell.Offset（0,-1）.Select'当前单元格向右移动一格
ActiveCell.Offset（1,0）.Select'当前单元格向下移动一格
ActiveCell.Offset（-1,0）.Select'当前单元格向上移动一格
endsub
如果上述程序产生错误那是因为单元格不能移动，为了解除上述错误，我们可以往
submy_offset之下加一段代码onerrorresumenext
注意以下代码都不再添加sub“代码名称〞和endsub请自己添加!
给当前单元格赋值
ActiveCell.Value="你好！
！
！
"
给指定单元格赋值
例如：
Ａ１单元格内容设为"ＨＥＬＬＯ"
Range（"a1"）.value="hello"
又如：
你现在的工作簿在sheet1上，你要往sheet2的Ａ１单元格中插入"ＨＥＬＬＯ"
1.
sheets（"sheet2"）.select
range（"a1"）.value="hello"
或
2.
Sheets（"sheet1"）.Range（"a1"）.Value="hello"
说明：
选中，然后在将“HELLO"赋到A1单元格中。
选中，即可“HELLO"赋到sheet2的A1单元格中。
隐藏工作表
'隐藏SHEET1这张工作表
sheets（"sheet1"）.Visible=False
'显示SHEET1这张工作表
sheets（"sheet1"）.Visible=True
打印预览
有时候我们想把所有的EXCEL中的SHEET都打印预览，请使用该段代码，它将在你现有的工作簿中循环，直到最后一个工作簿结束循环预览。
DimmyAsWorksheet
ForEachmyInWorksheets
my.PrintPreview
Nextmy
得到当前单元格的地址
得到当前日期及时间
msgboxdate&chr（13）&time
保护工作簿
ActiveSheet.Protect
取消保护工作簿
给活开工作表改名为"liu"
ActiveSheet.Name="liu"
翻开一个应用程序
AppActivate（Shell（"C:
/WINDOWS/CALC.EXE"））
删除活开工作表
翻开一个工作簿文件
Workbooks.OpenFileName:
="C:
/MyDocuments/Book2.xls"
关闭活动窗口
单元格格式
选定单元格左对齐
Selection.HorizontalAlignment=xlLeft
选定单元格居中
Selection.HorizontalAlignment=xlCenter
选定单元格右对齐
Selection.HorizontalAlignment=xlRight
选定单元格为百分号风格
Selection.Style="Percent"
选定单元格字体为粗体
Selection.Font.Bold=True
选定单元格字体为斜体
Selection.Font.Italic=True
选定单元格字体为宋体20号字
WithSelection.Font
.Name="宋体"
.Size=20
EndWith
With语句
With对象
.描述
EndWith
去除单元格
ActiveCell.Clear '删除所有文字、批注、格式
返回选定区域的行数
返回选
返回选定区域的地址
忽略所有的错误
ONERRORRESUMENEXT
遇错跳转
onerrorgotoerr_handle
'中间的其他代码
err_handle:
'标签
'跳转后的代码
删除一个文件
kill"c:
/1.txt"
定制自己的状态栏
Application.StatusBar="现在时刻:
"&Time
恢复自己的状态栏
Application.StatusBar=false
用代码执行一个宏
Application.Runmacro:
="text"
滚动窗口到a1的位置
ActiveWindow.ScrollRow=1
ActiveWindow.ScrollColumn=1
定制系统日期
DimMyDate,MyDay
MyDate=#12/12/69#
MyDay=Day（MyDate）
返回当天的时间
DimMyDate,MyYear
MyDate=Date
MyYear=Year（MyDate）
MsgBoxMyYear
inputbox<输入框>
XX=InputBox（"Enternumberofmonthstoadd"）
得到一个文件名
DimkkAsString
kk=Application.GetOpenFilename（"EXCEL（*.XLS）,*.XLS",Title:
="提示：
请翻开一个EXCEL文件：
"）
msgboxkk
翻开zoom对话框
Application.Dialogs（xlDialogZoom）.Show
激活字体对话框
Application.Dialogs（xlDialogActiveCellFont）.Show
翻开另存对话框
DimkkAsString
kk=Application.GetSaveAsFilename（"excel（*.xls）,*.xls"）
Workbooks.Openkk
工作簿（Workbook）根本操作应用例如
（一）
Workbook对象代表工作簿，而Workbooks集合那么包含了当前所有的工作簿。
下面对Workbook对象的重要的方法和属性以及其它一些可能涉及到的方法和属性进行例如介绍，同时，后面的例如也深入介绍了一些工作簿对象操作的方法和技巧。
例如03-01：
创立工作簿（Add方法）
[例如03-01-01]
SubCreateNewWorkbook1（）
MsgBox"将创立一个新工作簿."
Workbooks.Add
EndSub
[例如03-01-02]
SubCreateNewWorkbook2（）
DimwbAsWorkbook
DimwsAsWorksheet
DimiAsLong
MsgBox"将创立一个新工作簿,并预设工作表格式."
Setwb=Workbooks.Add
Setws=wb.Sheets
（1）
ws.Name="产品汇总表"
ws.Cells（1,1）="序号"
ws.Cells（1,2）="产品名称"
ws.Cells（1,3）="产品数量"
Fori=2To10
ws.Cells（i,1）=i-1
Nexti
EndSub
例如03-02：
添加并保存新工作簿
SubAddSaveAsNewWorkbook（）
DimWkAsWorkbook
SetWk=Workbooks.Add
Application.DisplayAlerts=False
Wk.SaveAsFilename:
="D:
/SalesData.xls"
EndSub
例如说明：
本例如使用了Add方法和SaveAs方法，添加一个新工作簿并将该工作簿以文件名盘中。
其中，语句Application.DisplayAlerts=False表示禁止弹出警告对话框。
例如03-03：
翻开工作簿（Open方法）
[例如03-03-01]
SubopenWorkbook1（）
Workbooks.Open"<需翻开文件的路径>/<文件名>"
EndSub
例如说明：
代码中的<>里的内容需用所需翻开的文件的路径及文件名代替。
Open方法共有15个参数，其中参数FileName为必需的参数，其余参数可选。
[例如03-03-02]
SubopenWorkbook2（）
DimfnameAsString
MsgBox"将D盘中的<测试.xls>工作簿以只读方式翻开"
fname="D:
/测试.xls"
Workbooks.OpenFilename:
=fname,ReadOnly:
=True
EndSub
例如03-04：
将文本文件导入工作簿中（OpenText方法）
SubTextToWorkbook（）
'本例如翻开某文本文件并将制表符作为分隔符对此文件进行分列处理转换成为工作表
Workbooks.OpenTextFilename:
="<文本文件所在的路径>/<文本文件名>",_
DataType:
=xlDelimited,Tab:
=True
EndSub
例如说明：
代码中的<>里的内容需用所载入的文本文件所在路径及文件名代替。
OpenText方法的作用是导入一个文本文件，并将其作为包含单个工作表的工作簿进行分列处理，然后在此工作表中放入经过分列处理的文本文件数据。
该方法共有18个参数，其中参数FileName为必需的参数，其余参数可选。
例如03-05：
保存工作簿（Save方法）
[例如03-05-01]
SubSaveWorkbook（）
MsgBox"保存当前工作簿."
ActiveWorkbook.Save
EndSub
[例如03-05-02]
SubSaveAllWorkbook1（）
DimwbAsWorkbook
MsgBox"保存所有翻开的工作簿后退出Excel."
ForEachwbInApplication.Workbooks
wb.Save
Nextwb
Application.Quit
EndSub
[例如03-05-03]
SubSaveAllWorkbook2（）
DimwbAsWorkbook
ForEachwbInWorkbooks
Ifwb.Path<>""Thenwb.Save
Nextwb
EndSub
例如说明：
本例如保存原来已存在且已翻开的工作簿。
例如03-06：
保存工作簿（SaveAs方法）
[例如03-06-01]
SubSaveWorkbook1（）
MsgBox"将工作簿以指定名保存在默认文件夹中."
ActiveWorkbook.SaveAs"<工作簿名>.xls"
EndSub
例如说明：
SaveAs方法相当于“另存为……〞命令，以指定名称保存工作簿。
该方法有12个参数，均为可选参数。
如果未指定保存的路径，那么将在默认文件夹中保存该工作簿。
如果文件夹中该工作簿名已存在，那么提示是否替换原工作簿。
[例如03-06-02]
SubSaveWorkbook2（）
DimoldNameAsString,newNameAsString
DimfolderNameAsString,fnameAsString
oldName=ActiveWorkbook.Name
newName="new"&oldName
MsgBox"将<"&oldName&">以<"&newName&">的名称保存"
folderName=Application.DefaultFilePath
fname=folderName&"/"&newName
ActiveWorkbook.SaveAsfname
EndSub
例如说明：
本例如将当前工作簿以一个新名（即new加原名）保存在默认文件夹中。
[例如03-06-03]
SubCreateBak1（）
MsgBox"保存工作簿并建立备份工作簿"
ActiveWorkbook.SaveAsCreateBackup:
=True
EndSub
例如说明：
本例如将在当前文件夹中建立工作簿的备份。
[例如03-06-04]
SubCreateBak2（）
MsgBox"保存工作簿时,假设已建立了备份,那么将出现包含True的信息框,否那么出现False."
MsgBoxActiveWorkbook.CreateBackup
EndSub
例如03-07：
取得当前翻开的工作簿数（Count属性）
SubWorkbookNum（）
MsgBox"当前已翻开的工作簿数为:
"&Chr（10）&Workbooks.Count
EndSub
例如03-08：
激活工作簿（Activate方法）
[例如03-08-01]
SubActivateWorkbook1（）
Workbooks（"<工作簿名>"）.Activate
EndSub
例如说明：
Activate方法激活一个工作簿，使该工作簿为当前工作簿。
[例如03-08-02]
SubActivateWorkbook2（）
DimnAsLong,iAsLong
DimbAsString
MsgBox"依次激活已经翻开的工作簿"
n=Workbooks.Count
Fori=1Ton
Workbooks（i）.Activate
b=MsgBox（"第"&i&"个工作簿被激活，还要继续吗?
",vbYesNo）
Ifb=vbNoThenExitSub
Ifi=nThenMsgBox"最后一个工作簿已被激活."
Nexti
EndSub
例如03-09：
保护工作簿（Protect方法）
SubProtectWorkbook（）
MsgBox"保护工作簿结构,密码为123"
ActiveWorkbook.ProtectPassword:
="123",Structure:
=True
MsgBox"保护工作簿窗口,密码为123"
ActiveWorkbook.ProtectPassword:
="123",Windows:
=True
MsgBox"保护工作簿结构和窗口,密码为123"
ActiveWorkbook.ProtectPassword:
="123",Structure:
=True,Windows:
=True
EndSub
例如说明：
使用Protect方法来保护工作簿，带有三个可选参数，参数Password指明保护工作簿密码，要解除工作簿保护应输入此密码；参数Structure设置为True那么保护工作簿结构，此时不能对工作簿中的工作表进行插入、复制、删除等操作；参数Windows设置为True那么保护工作簿窗口，此时该工作簿右上角的最小化、最大化和关闭按钮消失。
例如03-10：
解除工作簿保护（UnProtect方法）
SubUnprotectWorkbook（）
MsgBox"取消工作簿保护"
ActiveWorkbook.Unprotect"123"
EndSub
例如03-11：
工作簿的一些通用属性例如
SubtestGeneralWorkbookInfo（）
MsgBox"本工作簿的名称为"&ActiveWorkbook.Name
MsgBox"本工作簿带完整路径的名称为"&ActiveWorkbook.FullName
MsgBox"本工作簿对象的代码名为"&ActiveWorkbook.CodeName
MsgBox"本工作簿的路径为"&ActiveWorkbook.Path
IfActiveWorkbook.ReadOnlyThen
MsgBox"本工作簿已经是以只读方式翻开"
Else
MsgBox"本工作簿可读写."
EndIf
IfActiveWorkbook.SavedThen
MsgBox"本工作簿已保存."
Else
MsgBox"本工作簿需要保存."
EndIf
EndSub
例如03-12：
访问工作簿的内置属性（BuiltinDocumentProperties属性）
[例如03-12-01]
SubShowWorkbookProperties（）
DimSaveTimeAsString
OnErrorResumeNext
SaveTime=ActiveWorkbook.BuiltinDocumentProperties（"LastSaveTime"）.Value
IfSaveTime=""Then
MsgBoxActiveWorkbook.Name&"工作簿未保存."
Else
MsgBox"本工作簿已于"&SaveTime&"保存",,ActiveWorkbook.Name
EndIf
EndSub
例如说明：
在Excel中选择菜单“文件——属性〞命令时将会显示一个“属性〞对话框，该对话框中包含了当前工作簿的有关信息，可以在VBA中使用BuiltinDocumentProperties属性访问工作簿的属性。
上述例如代码将显示当前工作簿保存时的日期和时间。
[例如03-12-02]
SublistWorkbookProperties（）
OnErrorResumeNext
'在名为"工作簿属性"的工作表中添加信息,假设该工作表不存在,那么新建一个工作表
Worksheets（"工作簿属性"）.Activate
IfErr.Number<>0Then
Worksheets.Addafter:
=Worksheets（Worksheets.Count）
ActiveSheet.Name="工作簿属性"
Else
ActiveSheet.Clear
EndIf
OnErrorGoTo0
ListProperties
EndSub
‘-----------------------
SubListProperties（）
DimiAsLong
Cells（1,1）="名称"
Cells（1,2）="类型"
Cells（1,3）="值"
Range（"A1:
C1"）.Font.Bold=True
WithActiveWorkbook
Fori=1To.BuiltinDocumentProperties.Count
With.BuiltinDocumentProperties（i）
Cells（i+1,1）=.Name
SelectCase.Type
CasemsoPropertyTypeBoolean
Cells（i+1,2）="Boolean"
CasemsoPropertyTypeDate
Cells（i+1,2）="Date"
CasemsoPropertyTypeFloat
Cells（i+1,2）="Float"
CasemsoPropertyTypeNumber
Cells（i+1,2）="Number"
CasemsoPropertyTypeString
Cells（i+1,2）="string"
EndSelect
OnErrorResumeNext
Cells（i+1,3）=.Value
OnErrorGoTo0
EndWith
Nexti
EndWith
Range（"A:
C"）.Columns.AutoFit
EndSub
例如说明：
本例如代码在“工作簿属性〞工作表中列出了当前工作簿中的所有内置属性。
例如03-13：
测试工作簿中是否包含指定工作表（Sheets属性）
SubtestSheetExists（）
MsgBox"测试工作
升级会员 