Excel VBA编程地常用代码.docx

Excel VBA编程地常用代码.docx

《Excel VBA编程地常用代码.docx》由会员分享，可在线阅读，更多相关《Excel VBA编程地常用代码.docx（14页珍藏版）》请在冰豆网上搜索。

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_SelectSelection.CurrentRegion.SelectEndsub

返回当前单元格中数据删除前后空格后的值submy_trimmsgboxTrim（ActiveCell.Value）endsub

单元格位移submy_offsetActiveCell.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"）.selectrange（"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都打印预览，请使用该段代码，它将在你现有的工作簿中循环，直到最后一个工作簿完毕循环预览。

DimmyAsWorksheetForEachmyInWorksheetsmy.PrintPreviewNextmy

得到当前单元格的地址

得到当前日期与时间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=20EndWith

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=1ActiveWindow.ScrollColumn=1

定制系统日期DimMyDate,MyDayMyDate=#12/12/69#MyDay=Day（MyDate）

返回当天的时间DimMyDate,MyYearMyDate=DateMyYear=Year（MyDate）MsgBoxMyYear

inputbox<输入框>XX=InputBox（"Enternumberofmonthstoadd"）

得到一个文件名DimkkAsStringkk=Application.GetOpenFilename（"EXCEL（*.XLS）,*.XLS",Title:

="提示：

请打开一个EXCEL文件：

"）msgboxkk

打开zoom对话框Application.Dialogs（xlDialogZoom）.Show

激活字体对话框Application.Dialogs（xlDialogActiveCellFont）.Show

打开另存对话框DimkkAsStringkk=Application.GetSaveAsFilename（"excel（*.xls）,*.xls"）Workbooks.Openkk

工作簿（Workbook）根本操作应用示例

（一）

Workbook对象代表工作簿，而Workbooks集合如此包含了当前所有的工作簿。

下面对Workbook对象的重要的方法和属性以与其它一些可能涉与到的方法和属性进展示例介绍，同时，后面的示例也深入介绍了一些工作簿对象操作的方法和技巧。

示例03-01：

创建工作簿（Add方法）[示例03-01-01]SubCreateNewWorkbook1（） MsgBox"将创建一个新工作簿." Workbooks.AddEndSub[示例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 NextiEndSub

示例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:

=TrueEndSub

示例03-04：

将文本文件导入工作簿中（OpenText方法）SubTextToWorkbook（） '本示例打开某文本文件并将制表符作为分隔符对此文件进展分列处理转换成为工作表 Workbooks.OpenTextFilename:

="<文本文件所在的路径>/<文本文件名>",_     DataType:

=xlDelimited,Tab:

=TrueEndSub示例说明：

代码中的<>里的容需用所载入的文本文件所在路径与文件名代替。

OpenText方法的作用是导入一个文本文件，并将其作为包含单个工作表的工作簿进展分列处理，然后在此工作表中放入经过分列处理的文本文件数据。

该方法共有18个参数，其中参数FileName为必需的参数，其余参数可选。

示例03-05：

保存工作簿（Save方法）[示例03-05-01]SubSaveWorkbook（） MsgBox"保存当前工作簿." ActiveWorkbook.SaveEndSub[示例03-05-02]SubSaveAllWorkbook1（） DimwbAsWorkbook MsgBox"保存所有打开的工作簿后退出Excel." ForEachwbInApplication.Workbooks   wb.Save Nextwb Application.QuitEndSub[示例03-05-03]SubSaveAllWorkbook2（） DimwbAsWorkbook ForEachwbInWorkbooks   Ifwb.Path<>""Thenwb.Save NextwbEndSub示例说明：

本示例保存原来已存在且已打开的工作簿。

示例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.SaveAsfnameEndSub示例说明：

本示例将当前工作簿以一个新名（即new加原名）保存在默认文件夹中。

[示例03-06-03]SubCreateBak1（） MsgBox"保存工作簿并建立备份工作簿" ActiveWorkbook.SaveAsCreateBackup:

=TrueEndSub示例说明：

本示例将在当前文件夹中建立工作簿的备份。

[示例03-06-04]SubCreateBak2（） MsgBox"保存工作簿时,假设已建立了备份,如此将出现包含True的信息框,否如此出现False." MsgBoxActiveWorkbook.CreateBackupEndSub

示例03-07：

取得当前打开的工作簿数（Count属性）SubWorkbookNum（） MsgBox"当前已打开的工作簿数为:

"&Chr（10）&Workbooks.CountEndSub

示例03-08：

激活工作簿（Activate方法）[示例03-08-01]SubActivateWorkbook1（） Workbooks（"<工作簿名>"）.ActivateEndSub示例说明：

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"最后一个工作簿已被激活." NextiEndSub

示例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:

=TrueEndSub示例说明：

使用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"本工作簿需要保存." EndIfEndSub

示例03-12：

访问工作簿的置属性（BuiltinDocumentProperties属性）[示例03-12-01]SubShowWorkbookProperties（） DimSaveTimeAsString OnErrorResumeNext SaveTime=ActiveWorkbook.BuiltinDocumentProperties（"LastSaveTime"）.Value IfSaveTime=""Then   MsgBoxActiveWorkbook.Name&"工作簿未保存." Else   MsgBox"本工作簿已于"&SaveTime&"保存",,ActiveWorkbook.Name EndIfEndSub示例说明：

在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 ListPropertiesEndSub‘-----------------------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.AutoFitEndSub示例说明：

本示例代码在“工作簿属性〞工作表中列出了当前工作簿中的所有置属性。

示例03-13：

测试工作簿中是否包含指定工作表（Sheets属性）SubtestSheetExists（） MsgBox"测试工作簿中是否存在指定名称的工作表" DimbAsBoolean b=SheetExists（"<指定的工作表名>"） Ifb=TrueThen   MsgBox"该工作表存在于工作簿中." Else   MsgBox"工作簿中没有这个工作表." EndIfEndSub‘-----------------------PrivateFunctionSheetExists（sname）AsBoolean DimxAsObject OnErrorResumeNext Setx=ActiveWorkbook.Sheets（sname） IfErr=0Then   SheetExists=True Else   SheetExists=False EndIfEndFunction

示例03-14：

对未打开的工作簿进展重命名（Name方法）Subrename（） Name"<工作簿路径>/<旧名称>.xls"As"<工作簿路径>/<新名称>.xls"EndSub示例说明：

代码中<>中的容为需要重命名的工作簿所在路径与新旧名称。

该方法只是对未打开的文件进展重命名，如果该文件已经打开，使用该方法会提示错误。

示例03-15：

设置数字精度（PrecisionAsDisplayed属性）Sub