Excel VBA编程的常用代码.doc

1、Excel VBA 编程的常用代码 用过 VB 的人都应该知道如何声明变量，在 VBA 中声明变量和 VB 中是完全一样的！使用 Dim 语句Dim a as integer 声明 a 为整型 变量Dim a 声明 a 为变体变量Dim a as string 声明 a 为字符串变量Dim a as currency ,b as currency ,c as currency 声明 a,b,c 为货币变量声明变量可以是：Byte、Boolean、Integer、 Long、Currency、Single、Double、Decimal（当前不支持）、Date、String（只限变长字符串）、 S

2、tring * length（定长字符串）、Object、Variant、用户定义类型或对象类型。强制声明变量Option Explicit说明：该语句必在任何过程之前出现在模块中。声明常数用来代替文字值。Const 常数的默认状 态是 Private。Const My = 456 声明 Public 常数。Public Const MyString = “HELP“ 声明 Private Integer 常数。Private Const MyInt As Integer = 5 在同一行里声明多个常数。Const MyStr = “Hello“, MyDouble As Double = 3

3、.4567 选择当前单元格所在区域在 EXCEL97 中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部 选中。只要将该段代码加入到你的模块中。Sub My_SelectSelection.CurrentRegion.SelectEnd sub返回当前单元格中数据删除前后空格后的值sub my_trimmsgbox Trim(ActiveCell.Value)end sub单元格位移sub my_offsetActiveCell.Offset(0, 1).Select当前单元格向左移动一格ActiveCell.Offset(0, -1

4、).Select当前单元格向右移动一格ActiveCell.Offset(1 , 0).Select当前单元格向下移动一格ActiveCell.Offset(-1 , 0).Select当前单元格向上移动一格end sub如果上述程序产生错误那是因为单元格不能移动，为了解除上述 错误，我 们可以往sub my_offset 之下加一段代码 on error resume next注意以下代码都不再添加 sub “代码名称” 和 end sub 请 自己添加!给当前单元格赋值ActiveCell.Value = “你好！“给指定单元格赋值例如：单元格内容设为“ “Range(“a1“).valu

5、e=“hello“又如：你现在的工作簿在 sheet1 上，你要往 sheet2 的 单元格中插入“1.sheets(“sheet2“).selectrange(“a1“).value=“hello“或2.Sheets(“sheet1“).Range(“a1“).Value = “hello“说明：1.sheet2 被选中，然后在将 “HELLO“赋到 A1 单元格中。2.sheet2 不必被选中，即可“HELLO“赋到 sheet2 的 A1 单元格中。隐藏工作表隐藏 SHEET1 这张工作表sheets(“sheet1“).Visible=False显示 SHEET1 这张工作表sheet

6、s(“sheet1“).Visible=True打印预览有时候我们想把所有的 EXCEL 中的 SHEET 都打印预览，请使用该段代码，它将在你现有的工作簿中循环，直到最后一个工作簿 结束循环预览。Dim my As WorksheetFor Each my In Worksheetsmy.PrintPreviewNext my得到当前单元格的地址msgbox ActiveCell.Address得到当前日期及时间msgbox date & chr(13) & time保护工作簿ActiveSheet.Protect 取消保护工作簿ActiveSheet.Unprotect给活动工作表改名为

7、“liu“ActiveSheet.Name = “liu“打开一个应用程序AppActivate (Shell(“C:/WINDOWS/CALC.EXE“)增加一个工作表Worksheets.Add删除活动工作表activesheet.delete打开一个工作簿文件Workbooks.Open FileName:=“C:/My Documents/Book2.xls“关闭活动窗口ActiveWindow.Close单元格格式选定单元格左对齐Selection.HorizontalAlignment = xlLeft选定单元格居中Selection.HorizontalAlignment = x

8、lCenter选定单元格右对齐Selection.HorizontalAlignment = xlRight选定单元格为百分号风格Selection.Style = “Percent“选定单元格字体为粗体Selection.Font.Bold = True选定单元格字体为斜体Selection.Font.Italic = True选定单元格字体为宋体 20 号字With Selection.Font.Name = “宋体“.Size = 20End WithWith 语句With 对象.描述End With清除单元格ActiveCell.Clear 删除所有文字、批注、格式返回选定区域的行数M

9、sgBox Selection.Rows.Count返回选定区域的列数MsgBox Selection.Columns.Count返回选定区域的地址Selection.Address忽略所有的错误ON ERROR RESUME NEXT遇错跳转on error goto err_handle中间 的其他代码err_handle: 标签跳转 后的代 码删除一个文件kill “c:/1.txt“定制自己的状态栏Application.StatusBar = “现在时刻: “ & Time恢复自己的状态栏Application.StatusBar = false用代码执行一个宏Application

10、.Run macro:=“text“滚动窗口到 a1 的位置ActiveWindow.ScrollRow = 1ActiveWindow.ScrollColumn = 1定制系统日期Dim MyDate, MyDayMyDate = #12/12/69#MyDay = Day(MyDate)返回当天的时间Dim MyDate, MyYearMyDate = Date MyYear = Year(MyDate)MsgBox MyYear inputboxXX=InputBox (“Enter number of months to add“)得到一个文件名Dim kk As Stringkk =

11、 Application.GetOpenFilename(“EXCEL (*.XLS), *.XLS“, Title:=“提示：请打开一个EXCEL 文件：“)msgbox kk打开 zoom 对话 框Application.Dialogs(xlDialogZoom).Show激活字体对话框Application.Dialogs(xlDialogActiveCellFont).Show打开另存对话框Dim kk As Stringkk = Application.GetSaveAsFilename(“excel (*.xls), *.xls“)Workbooks.Open kk工作簿(Work

12、book) 基本操作应用示例(一)Workbook 对象代表工作簿，而 Workbooks 集合则包含了当前所有的工作簿。下面对Workbook 对象的重要的方法和属性以及其它一些可能涉及到的方法和属性进行示例介绍，同时，后面的示例也深入介绍了一些工作簿 对象操作的方法和技巧。示例 03-01：创 建工作簿(Add 方法)示例 03-01-01Sub CreateNewWorkbook1()MsgBox “将创建一个新工作簿.“Workbooks.AddEnd Sub示例 03-01-02Sub CreateNewWorkbook2()Dim wb As WorkbookDim ws As W

13、orksheetDim i As LongMsgBox “将创建一个新工作簿,并预设工作表格式.“Set wb = Workbooks.AddSet ws = wb.Sheets(1)ws.Name = “产品汇总表“ws.Cells(1, 1) = “序号“ws.Cells(1, 2) = “产品名称“ws.Cells(1, 3) = “产品数量“For i = 2 To 10ws.Cells(i, 1) = i - 1Next iEnd Sub示例 03-02：添加并保存新工作簿Sub AddSaveAsNewWorkbook()Dim Wk As WorkbookSet Wk = Wor

14、kbooks.AddApplication.DisplayAlerts = FalseWk.SaveAs Filename:=“D:/SalesData.xls“End Sub示例说明：本示例使用了 Add 方法和 SaveAs 方法，添加一个新工作簿并将该工作簿以文件名SalesData.xls 保存在 D 盘中。其中， 语句 Application.DisplayAlerts = False 表示禁止弹出警告对话框。示例 03-03：打 开工作簿(Open 方法)示例 03-03-01Sub openWorkbook1()Workbooks.Open “/“End Sub示例说明：代码中的

15、里的内容需用所载入的文本文件所在路径及文件名代替。OpenText 方法的作用是导入一个文本文件，并将其作 为包含单个工作表的工作簿 进行分列处理，然后在此工作表中放入经过分列处理的文本文件数据。 该方法共有 18 个参数，其中参数 FileName 为必需的参数，其余参数可选。示例 03-05：保存工作簿 (Save 方法)示例 03-05-01Sub SaveWorkbook()MsgBox “保存当前工作簿.“ActiveWorkbook.SaveEnd Sub示例 03-05-02Sub SaveAllWorkbook1()Dim wb As WorkbookMsgBox “保存所有打

16、开的工作簿后退出 Excel.“For Each wb In Application.Workbookswb.SaveNext wbApplication.QuitEnd Sub示例 03-05-03Sub SaveAllWorkbook2()Dim wb As WorkbookFor Each wb In WorkbooksIf wb.Path 0 ThenWorksheets.Add after:=Worksheets(Worksheets.Count)ActiveSheet.Name = “工作簿属性“ElseActiveSheet.ClearEnd IfOn Error GoTo 0L

17、istPropertiesEnd Sub- - - - - - - - - - - - - - - - - - - - - - - Sub ListProperties()Dim i As LongCells(1, 1) = “名称“Cells(1, 2) = “类型“Cells(1, 3) = “值“Range(“A1:C1“).Font.Bold = TrueWith ActiveWorkbookFor i = 1 To .BuiltinDocumentProperties.CountWith .BuiltinDocumentProperties(i)Cells(i + 1, 1) = .

18、NameSelect Case .TypeCase msoPropertyTypeBooleanCells(i + 1, 2) = “Boolean“Case msoPropertyTypeDateCells(i + 1, 2) = “Date“Case msoPropertyTypeFloatCells(i + 1, 2) = “Float“Case msoPropertyTypeNumberCells(i + 1, 2) = “Number“Case msoPropertyTypeStringCells(i + 1, 2) = “string“End SelectOn Error Resu

19、me NextCells(i + 1, 3) = .ValueOn Error GoTo 0End WithNext iEnd WithRange(“A:C“).Columns.AutoFitEnd Sub示例说明：本示例代码在“工作簿属性 ”工作表中列出了当前工作簿中的所有内置属性。示例 03-13：测试 工作簿中是否包含指定工作表 (Sheets 属性 )Sub testSheetExists()MsgBox “测试工作簿中是否存在指定名称的工作表“Dim b As Booleanb = SheetExists(“)If b = True ThenMsgBox “该工作表存在于工作簿中.“

20、ElseMsgBox “工作簿中没有这个工作表.“End IfEnd Sub- - - - - - - - - - - - - - - - - - - - - - - Private Function SheetExists(sname) As BooleanDim x As ObjectOn Error Resume NextSet x = ActiveWorkbook.Sheets(sname)If Err = 0 ThenSheetExists = TrueElseSheetExists = FalseEnd IfEnd Function示例 03-14：对 未打开的工作簿 进行重命名(

21、Name 方法)Sub rename()Name “/.xls“ As “/.xls“End Sub示例说明：代码中ThisWorkbook.Name ThenBook.Close savechanges:=TrueEnd IfNext BookThisWorkbook.Close savechanges:=TrueEnd Sub示例 03-24-05 关闭工作簿并将它 彻底删除Sub KillMe() With ThisWorkbook .Saved = True .ChangeFileAccess Mode:=xlReadOnly Kill .FullName .Close False E

22、nd WithEnd Sub示例 03-24-06关闭所有工作簿，若工作簿已改变则弹出是否保存变化的对话框Sub closeAllWorkbook()MsgBox “关闭当前所打开的所有工作簿“Workbooks.CloseEnd Sub 工作簿(Workbook) 基本操作应用示例(二) 示例 03-25：创 建新的工作簿Sub testNewWorkbook()MsgBox “创建一个带有 10 个工作表的新工作簿“Dim wb as WorkbookSet wb = NewWorkbook(10)End Sub- - - - - - - - - - - - - - - - - - - -

23、 - - - Function NewWorkbook(wsCount As Integer) As Workbook创建 带 有由变 量 wsCount 提定数量工作表的工作簿，工作表数在 1 至 255 之间Dim OriginalWorksheetCount As LongSet NewWorkbook = NothingIf wsCount 255 Then Exit FunctionOriginalWorksheetCount = Application.SheetsInNewWorkbookApplication.SheetsInNewWorkbook = wsCountSet N

24、ewWorkbook = Workbooks.AddApplication.SheetsInNewWorkbook = OriginalWorksheetCountEnd Function示例说明：自定义函数 NewWorkbook 可以创建最多带有 255 个工作表的工作簿。本测试示例创建一个带有 10 个工作表的新工作簿。示例 03-26：判断工作簿是否存在Sub testFileExists()MsgBox “如果文件不存在则用信息框说明,否则打开该文件.“If Not FileExists(“C:/文件夹/子文件夹/ 文件.xls“) ThenMsgBox “这个工作簿不存在!“Els

25、eWorkbooks.Open “C:/文件夹/子文件夹/ 文件.xls“End IfEnd Sub- - - - - - - - - - - - - - - - - - - - - - - Function FileExists(FullFileName As String) As Boolean如果工作簿存在,则返回 TrueFileExists = Len(Dir(FullFileName) 0End Function示例说明：本示例使用自定义函数 FileExists 判断工作簿是否存在，若该工作簿已存在， 则打开它。代码中，“C:/文件夹/子文件 夹/文件.xls”代表工作簿所在的文

26、件 夹名、子文件夹名和工作簿文件名。示例 03-27：判断工作簿是否已打开示例 03-27-01Sub testWorkbookOpen()MsgBox “如果工作簿未打开,则打开该工作簿.“If Not WorkbookOpen(“工作簿名.xls“) ThenWorkbooks.Open “工作簿名.xls“End IfEnd Sub- - - - - - - - - - - - - - - - - - - - - - - Function WorkbookOpen(WorkBookName As String) As Boolean如果该工作簿已打 开则返回真WorkbookOpen =

27、 FalseOn Error GoTo WorkBookNotOpenIf Len(Application.Workbooks(WorkBookName).Name) 0 ThenWorkbookOpen = TrueMsgBox “该工作簿已打开“Exit FunctionEnd IfWorkBookNotOpen:End Function示例说明：本示例中的函数 WorkbookOpen 用来判断工作簿是否打开。 代码中，“工作簿名.xls”代表所要打开的工作簿名称。示例 03-27-02Sub testWookbookIFOpen()Dim wb As StringDim bwb As

28、Booleanwb = “bwb = WorkbookIsOpen(wb)If bwb = True ThenMsgBox “工作簿“ & wb & “已打开.“ElseMsgBox “工作簿“ & wb & “未打开.“End IfEnd Sub- - - - - - - - - - - - - - - - - - - - - - - Private Function WorkbookIsOpen(wbname) As BooleanDim x As WorkbookOn Error Resume NextSet x = Workbooks(wbname)If Err = 0 ThenWor

29、kbookIsOpen = TrueElseWorkbookIsOpen = FalseEnd IfEnd Function示例 03-28：备 份工作簿示例 03-28-01 用与活动工作簿相同的名字但后 缀名为.bak 备份工作簿Sub SaveWorkbookBackup()Dim awb As Workbook, BackupFileName As String, i As Integer, OK As BooleanIf TypeName(ActiveWorkbook) = “Nothing“ Then Exit SubSet awb = ActiveWorkbookIf awb.P

30、ath = “ ThenApplication.Dialogs(xlDialogSaveAs).ShowElseBackupFileName = awb.FullNamei = 0While InStr(i + 1, BackupFileName, “.“) 0i = InStr(i + 1, BackupFileName, “.“)WendIf i 0 Then BackupFileName = Left(BackupFileName, i - 1)BackupFileName = BackupFileName & “.bak“OK = FalseOn Error GoTo NotAbleT

31、oSaveWith awbApplication.StatusBar = “正在保存工作簿.“.SaveApplication.StatusBar = “正在备份工作簿.“.SaveCopyAs BackupFileNameOK = TrueEnd WithEnd IfNotAbleToSave:Set awb = NothingApplication.StatusBar = FalseIf Not OK ThenMsgBox “备份工作簿未保存!“, vbExclamation, ThisWorkbook.NameEnd IfEnd Sub示例说明：在当前工作簿中运行本示例代码后，将以与工作

32、簿相同的名称但后 缀名为.bak 备份工作簿，且该备份与当前工作簿在同一文件 夹中。其中，使用了工作簿的 FullName 属性和SaveCopyAs 方法。示例 03-28-02 保存当前工作簿的副本到其它位置 备份工作簿Sub SaveWorkbookBackupToFloppyD()Dim awb As Workbook, BackupFileName As String, i As Integer, OK As BooleanIf TypeName(ActiveWorkbook) = “Nothing“ Then Exit SubSet awb = ActiveWorkbookIf a

33、wb.Path = “ ThenApplication.Dialogs(xlDialogSaveAs).ShowElseBackupFileName = awb.NameOK = FalseOn Error GoTo NotAbleToSaveIf Dir(“D:/“ & BackupFileName) “wbCount = wbCount + 1ReDim Preserve wbList(1 To wbCount)wbList(wbCount) = wbNamewbName = DirWendIf wbCount = 0 Then Exit Sub从每个工作簿中 获取数据r = 0Workb

34、ooks.AddFor i = 1 To wbCountr = r + 1cValue = GetInfoFromClosedFile(FolderName, wbList(i), “Sheet1“, “A1“)Cells(r, 1).Formula = wbList(i)Cells(r, 2).Formula = cValueNext iEnd Sub- - - - - - - - - - - - - - - - - - - - - - - Private Function GetInfoFromClosedFile(ByVal wbPath As String, _wbName As St

35、ring, wsName As String, cellRef As String) As VariantDim arg As StringGetInfoFromClosedFile = “If Right(wbPath, 1) “/“ Then wbPath = wbPath & “/“If Dir(wbPath & “/“ & wbName) = “ Then Exit Functionarg = “ & wbPath & “ & wbName & “ & _wsName & “!“ & Range(cellRef).Address(True, True, xlR1C1)On Error

36、Resume NextGetInfoFromClosedFile = ExecuteExcel4Macro(arg)End Function示例说明：本示例将读取一个文件夹内所有工作簿中工作表 Sheet1 上单元格 A1 中的值到一个新工作簿中。代码中，“C:/文件夹名”代表工作簿所在的文件夹名。示例 03-29-03Sub GetDataFromClosedWorkbook()Dim wb As WorkbookApplication.ScreenUpdating = False以只读方式打 开工作簿Set wb = Workbooks.Open(“C:/文件夹名/文件.xls“, Tru

37、e, True)With ThisWorkbook.Worksheets(“工作表名“)从工作簿中读 取数据.Range(“A10“).Formula = wb.Worksheets(“源工作表名 “).Range(“A10“).Formula.Range(“A11“).Formula = wb.Worksheets(“源工作表名 “).Range(“A20“).Formula.Range(“A12“).Formula = wb.Worksheets(“源工作表名 “).Range(“A30“).Formula.Range(“A13“).Formula = wb.Worksheets(“源工作

38、表名 “).Range(“A40“).FormulaEnd Withwb.Close False 关闭打开的源数据工作簿且不保存任何变化Set wb = Nothing 释放内存Application.ScreenUpdating = TrueEnd Sub示例说明：在运行程序时，打开 所要获取数据的工作簿，当取得数据后再关闭该工作簿。将屏幕更新属性值设置为 False，将看不出源数据工作簿是否被打 开过。本程序代 码中，“C:/文件夹名/文件.xls”、“ 源工作表名“ 代表工作簿所在的文件夹和工作簿文件名 VBA 语句集前面已经推出了两辑 VBA 语 句集，共有 200 句 VBA 常用代

39、码及代码功能的简要解释。根据前阶段在学习 VBA 过程中总结归纳 的成果，特汇编了 VBA 语句集第 3 辑，供大家在学习VBA 编 程时参考。其实，您可以在 VBE 编辑器中将这些语句进行测试，以体验其作用或效果。VBA 语 句集的特点是，一句 VBA 代码，后面配有代码功能简要的说明或解释。每辑 100 句，尽可能收录所有在程序中所要用到的代码。(201) Set objExcel = CreateObject(“Excel.Application“)objExcel.Workbooks.Add 创建 Excel 工作簿(202) Application.ActivateMicrosoft

40、App xlMicrosoftWord 开启 Word 应用程序(203) Application.TemplatesPath 获取工作簿模板的位置(204) Application.Calculation = xlCalculationManual 设置工作簿手 动计算Application.Calculation = xlCalculationAutomatic 工作簿自动计算(205) Worksheets(1).EnableCalculation = False 不对第一 张工作表自动进行重算(206) Application.CalculateFull 重新计算所有打开的工作簿中的数

41、据(207) Application.RecentFiles.Maximum = 5 将最近使用的文档列表数设为 5(208) Application.RecentFiles(4).Open 打开最近打开的文档中的第 4 个文档(209) Application.OnTime DateSerial(2006,6,6)+TimeValue(“16:16:16”),“BaoPo” 在 2006年 6 月 6 日的 16:16:16 开始运行 BaoPo 过程(210) Application.Speech.Speak (“Hello“ & Application.UserName) 播放声音，并使

42、用用户的姓名问候用户(211) MsgBox Application.PathSeparator 获取“/“ 号(212) MsgBox Application.International(xlCountrySetting) 返回应用程序当前所在国家的设置信息(213) Application.AutoCorrect.AddReplacement “葛洲坝“, “三峡“ 自动将在工作表中进行输入的“葛洲 坝“ 更正 为“三峡“(214) Beep 让计算机发出声音(215) Err.Number 返回错误代码(216) MsgBox IMEStatus 获取输入法状态(217) Date =

43、#6/6/2006#Time = #6:16:16 AM# 将系统时间更改为 2006 年 6 月 6 日上午 6 时 16 分 16 秒(218) Application.RollZoom = Not Application.RollZoom 切换是否能利用鼠标中间的滑轮放大/缩小工作表(219) Application.ShowWindowsInTaskba = True 显示任务栏中的窗口,即各工作簿占用各自的窗口(220) Application.DisplayScrollBars = True 显示窗口上的 滚动条(221) Application.DisplayFormulaBar

44、 = Not Application.DisplayFormulaBar 切换是否显示编辑栏(222) Application.Dialogs(xlDialogPrint).Show 显示打印内容对话框(223) Application.MoveAfterReturnDirection = xlToRight 设置按 Enter 键后单元格的移动方向向右(224) Application.FindFile 显 示打开对话框(225) ThisWorkbook.FollowHyperlink http:/ 打开超链接文档(226) ActiveWorkbook.ChangeFileAccess

45、Mode:=xlReadOnly 将当前工作簿设置为只读(227) ActiveWorkbook.AddToFavorites 将当前工作簿添加到收藏夹文件夹中(228) ActiveSheet.CheckSpelling 在当前工作表中执行“拼写检查“(229) ActiveSheet.Protect userinterfaceonly:=True 保护 当前工作表(230) ActiveSheet.PageSetup.LeftHeader = ThisWorkbook.FullName 在当前工作表的左侧页眉处打印出工作簿的完整路径和文件名(231) Worksheets(“Sheet1“

46、).Range(“A1:G37“).Locked = FalseWorksheets(“Sheet1“).Protect解除 对 工作表 Sheet1 中 A1:G37 区域单元格的锁定以便当该工作表受保 护时也可对这些单元格进行修改(232) Worksheets(“Sheet1“).PrintPreview 显示工作表 sheet1 的打印预览窗口(233) ActiveSheet.PrintPreview Enablechanges:=False 禁用显示在 Excel 的“ 打印预览”窗口中的“设置” 和“页边距”按钮(234) ActiveSheet.PageSetup.PrintG

47、ridlines = True 在打印 预览中显示网格线ActiveSheet.PageSetup.PrintHeadings = True 在打印预览中显示行列编号(235) ActiveSheet.ShowDataForm 开启数据记录单(236) Worksheets(“Sheet1“).Columns(“A“).Replace _What:=“SIN“, Replacement:=“COS“, _SearchOrder:=xlByColumns, MatchCase:=True 将工作表 sheet1 中 A 列的 SIN 替换为COS(237) Rows(2).Delete 删除当前

48、工作表中的第 2 行Columns(2).Delete 删除当前工作表中的第 2 列(238) ActiveWindow.SelectedSheets.VPageBreaks.Add before:=ActiveCell 在当前单元格左侧插入一条垂直分页符ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveCell 在当前单元格上方插入一条垂直分页符(239) ActiveWindow.ScrollRow = 14 将当前工作表窗口滚动到第 14 行ActiveWindow.ScrollColumn = 13 将当前工作表窗口滚动

49、到第 13 列(240) ActiveWindow.Close 关闭当前窗口(241) ActiveWindow.Panes.Count 获取当前窗口中的窗格数(242) Worksheets(“sheet1“).Range(“A1:D2“).CreateNames Top:=True 将 A2 至 D2 的单元格名称设定为 A1 到 D1 单元格的内容(243) Application.AddCustomList listarray:=Range(“A1:A8“) 自定义当前工作表中单元格 A1至 A8 中的内容为自动填充序列(244) Worksheets(“sheet1“).Range(“A1:B2“).CopyPicture xlScreen, xlBitmap 将单元格 A1至 B2 的内容 复制成屏幕快照(245) Selection.Hyperlinks.Delete 删除所选区域的所有链接Columns(1).Hyperlinks.