豆丁微信公众号
君，已阅读到文档的结尾了呢~~
Excel VBA的使用对话框对,使用,excel,用VBA,Excel,VBA,对话框,话框,使用对话框,使用VBA
扫扫二维码，随身浏览文档
手机或平板扫扫即可继续访问
Excel VBA的使用对话框
举报该文档为侵权文档。
举报该文档含有违规或不良信息。
反馈该文档无法正常浏览。
举报该文档为重复文档。
推荐理由：
将文档分享至：
分享完整地址
文档地址：
粘贴到BBS或博客
flash地址：
支持嵌入FLASH地址的网站使用
html代码：
&embed src='http://www.docin.com/DocinViewer-4.swf' width='100%' height='600' type=application/x-shockwave-flash ALLOWFULLSCREEN='true' ALLOWSCRIPTACCESS='always'&&/embed&
450px*300px480px*400px650px*490px
支持嵌入HTML代码的网站使用
您的内容已经提交成功
您所提交的内容需要审核后才能发布，请您等待！
3秒自动关闭窗口当前位置： >>
VBA常用技巧下
VBA 常用技巧代码解析yuanzhuping第1章 使用对话框 章技巧1 技巧 使用 Msgbox 函数1-1 显示简单的提示信息 在使用 Excel 的过程中， 如果需要向用户显示简单的提示信息， 可以使用 MsgBox 函数 显示一个消息框，如下面的代码所示。#001 Sub mymsgbox() #002 MsgBox &欢迎光临 Excel Home!&#003 End Sub代码解析： Mymsgbox 过程使用 MsgBox 函数显示一个消息框。MsgBox 函数用于显示提示信息， 语法如下：MsgBox(prompt[, buttons] [, title] [, helpfile, context])参数 prompt 是必需的，代表在消息框中作为信息显示的字符或字符串，最多只能接受 约 1024 个字符，取决于所使用字符的宽度。 参数 buttons 是可选的，用于指定消息框中显示按钮的数目及类型、使用的图标样式、 缺省按钮以及消息框的强制回应等。如果省略，则 buttons 参数的缺省值为 0，消息框只显 示“确定”按钮。 参数 title 是可选的，代表在消息框标题栏中作为标题的字符或字符串。如果省略，则在 标题栏中显示“Microsoft Excel” 。 参数 helpfile 和参数 context 是可选的，用来为消息框提供上下文相关帮助的帮助文件 和帮助主题。如果提供了其中一个参数，则必须提供另一个参数，两者缺一不可。 运行 Mymsgbox 过程，显示如图 1-1 所示的消息框。1VBA 常用技巧代码解析yuanzhuping图 1-1简单的信息提示1-2 定制个性化的消息框 定制个性化的消息框 如果希望 MsgBox 函数显示的消息框具有特定的按钮、图标和标题栏，那么可以使用 MsgBox 函数的 buttons 参数和 title 参数，如下面的代码所示。#001 Sub Specialmsbox() #002 #003 #004 MsgBox Prompt:=&欢迎光临 Excel Home!&, _ Buttons:=vbOKCancel + vbInformation, _ Title:=&Excel Home&#005 End Sub代码解析： Specialmsbox 过程使用 MsgBox 函数显示一个具有特定的按钮、图标和标题栏的消息 框。 第 3 行代码设置消息框的 Buttons 参数，使消息框显示时具有“确定”“取消”按钮和 、 信息消息图标。MsgBox 函数的 buttons 参数设置值如表格 1-1 所示。参数组 第一组设置消 息框按钮数目 和类型 VbAbortRetryIgnore VbYesNoCancel VbYesNo VbRetryCancel 第二组设置图 标的风格 VbCritical VbQuestion VbExclamation VbInformation 第三组设置默 认按钮 vbDefaultButton1 vbDefaultButton2 vbDefaultButton3 2 3 4 5 16 32 48 64 0 256 512 显示“放弃”、“重试”、和“忽略”按钮 显示“是”、“否”和“取消”按钮 显示“是”和“否”按钮 显示“重试”和“取消”按钮 显示危险消息图标 显示警告询问图标 显示警告消息图标 显示信息消息图标 第一个按钮为默认按钮 第二个按钮为默认按钮 第三个按钮为默认按钮 常数 vbOKOnly VbOKCancel 值 0 1 描述 只显示“确定”按钮（默认设置） 显示“确定”和“取消”按钮2VBA 常用技巧代码解析yuanzhupingvbDefaultButton4 第四组设置消 息框特征 vbSystemModal vbApplicationModal768 0第四个按钮为默认按钮 应用程序模式： 用户必须对消息框作出响应才能继 续使用当前的应用程序4096系统模式： 应用程序都被挂起直至用户对消息框作 出响应第五组附加选 项vbMsgBoxHelpButton VbMsgBoxSetForeground vbMsgBoxRight 52428 8在消息框上添加“帮助”按钮 将消息框设置为前景窗口 显示右对齐的消息框vbMsgBoxRtlReading10485 76指定在希伯来和阿拉伯语系统中显示的文本应当 从右到左阅读表格 1-1 MsgBox 函数的 buttons 参数值在设定 buttons 参数值时，这些值可以相加使用，但每一组中只能选择一个值。在程序 代码中也可以使用 buttons 参数的常数名称，而不必使用实际数值。 第 4 行代码将消息框的 Title 参数设置为 “Excel Home” 使消息框的标题栏显示 ， “Excel Home” 。 运行 Specialmsbox 过程后，显示一个如图 1-2 所示的消息框，该消息框具有“Excel Home”标题、信息消息图标和“确定”“取消”按钮并以“确定”按钮作为默认按钮。 、图 1-2具有特定按钮、图标和标题栏的消息框1-3 获得消息框的返回值 如果希望能根据用户对于消息框的不同选择， 进行相应的操作， 可以对消息框的返回值 进行判断，如下面的代码所示。#001 Private Sub Workbook_BeforeClose(Cancel As Boolean) #002 #003 #004 #005 #006 Dim iMsg As Integer iMsg = MsgBox(&文件即将关闭,是否保存?&, 3 + 32) Select Case iMsg Case 6 Me.Save3VBA 常用技巧代码解析yuanzhuping#007 #008 #009 #010 #011Case 7 Me.Saved = True Case 2 Cancel = True End Select#012 End Sub代码解析： 工作簿的 BeforeClose 过程，在关闭工作簿前使用 MsgBox 函数显示一个消息框，并 根据用户的回应用进行相应的操作。 第 3 行代码，使用 MsgBox 函数显示一个具有“是”“否”和“否”按钮的消息框， 、 并把用户的回应，即消息框的返回值赋给变量 iMsg。MsgBox 是一个函数，这意味着它将 返回一个值，如果希望获得返回值，可使用和第 3 行相似的代码，此时如果不使用括号将参 数封闭起来，则会提示编译错误，如图 1-3 所示。图 1-3提示编译错误第 4 行到第 11 行代码，Select Case 结构语句，根据变量 iMsg 的值判断用户的回应， 如果变量 iMsg 的值为 6，说明用户选择了“是”按钮，则使用 Save 方法保存工作簿；如 果变量 iMsg 的值为 7， 说明用户选择了 “否” 按钮， 则将工作簿的 Saved 属性设置为 True， 不保存更改而直接关闭工作簿。关于 Save 方法和 Saved 属性请参阅技巧错误！未找到引 错误！ 错误 用源。 。如果变量 iMsg 的值为 2，说明用户选择了“取消”按钮，是将 BeforeClose 过程的 用源。 Cancel 参数设置为 True，取消关闭工作簿操作。 MsgBox 函数的返回值如表格 1-2 所示， 在程序代码中也可以使用常数名称， 而不必使 用实际数值。常数 vbOK vbCancel vbAbort vbRetry vbIgnore 值 1 2 3 4 5 描述 确定 取消 放弃 重试 忽略4VBA 常用技巧代码解析yuanzhupingvbYes vbNo6 7是 否表格 1-2 MsgBox 函数的返回值在关闭本工作簿时将显示一个如图 1-4 所示的消息框，询问用户是否保存，并根据用 户的回应用进行相应的操作。图 1-4询问消息框1-4 在消息框中排版 如果在消息框中显示的字符串很长， 比如是一段多行的文字内容， 为了达到美观的效果， 需要首字缩进，并将各行分隔开来，如下面代码所示。#001 Sub Newlinemsbox() #002 MsgBox Space(4) & &欢迎来到 ExcelHome 技术论坛，全球最领先的 Excel 技术论坛之一。& & Chr(10) _ #003 & Space(4) & &在这里，我们讨论 Microsoft Office 系列产品的应用技术，重点讨论& & Chr(10) _ #004 #005 & &Microsoft Excel。& & Chr(10) _ & Space(4) & &本论坛从属于 Excel Home 这一全球最大的华语 Excel 技术门户，目前& & Chr(10) _ #006 #007 & &是个人、非营利性质的网站学习平台。& & Chr(10) _ & Space(4) & &Let’s do it better! 这是 Excel Home 的口号，我们的宗旨是帮助大& & Chr(10) _ #008 & &家解决在使用 Office 软件中的问题，提升自己的应用技能。&#009 End Sub代码解析： Newlinemsbox 过程使用消息框显示一段经过排版后的文本内容。 代码中使用 Space 函数在每段的首字前插入 4 个空格，使首字缩进，在需要换行的地 方插入换行符 （Chr(10)） 将各行分隔开来。也可以使用回车符 （Chr(13)） 、或是回车与 换行符的组合 （Chr(13) & Chr（10)）换行。5VBA 常用技巧代码解析yuanzhuping在程序代码中也可以使用 vbCrLf、vbNewLine 等常数，而不必使用 Chr 函数，如表格 1-3 所示。常数 vbCrLf vbCr vbLf vbNewLine 等于 Chr(13) + Chr(10) Chr(13) Chr(10) Chr(13) + Chr(10) or, on the Macintosh, Chr(13) 描述 回车符与换行符结合 回车符 换行符 平台指定的新行字符表格 1-3 回车符与换行符运行 Newlinemsbox 过程, 用消息框显示一段经过排版后的文本内容,效果如图 1-5 所 示。图 1-5在消息框中排版1-5 对齐消息框中显示的信息 在用消息框显示如图 1-6 所示的工作表中多行多列的单元格区域时，如果只用换行符 （Chr(10)）等进行换行，而数据列没有对齐，会使显示的信息显得杂乱无章，缺乏可读性， 如图 1-7 所示。图 1-6工作表单元格区域6VBA 常用技巧代码解析yuanzhuping图 1-7没有对列进行分隔的消息框为了达到消息框中显示信息各列对齐的效果，在使用换行符（Chr(10)）等进行换行的 基础上，还需要使用制表符（Chr(9)）或常数 vbTab，对数据列进行分隔，使之排列整齐， 如下面代码所示。#001 Sub Outmsbox() #002 #003 #004 #005 #006 #007 #008 #009 #010 #011 Dim sMsg As String Dim iRow As Integer Dim iCom As Integer For iRow = 1 To 11 For iCom = 1 To 5 sMsg = sMsg & Cells(iRow, iCom) & Chr(9) Next sMsg = sMsg & Chr(10) Next MsgBox sMsg#012 End Sub代码解析： Outmsbox 过程使用两层循环读取当前工作表中 A1 到 E11 单元格的内容，并用消息框 显示出来。 第 7 行代码，iCom 循环中在把逐列读取的单元格内容赋给变量 myMsg 时插入一个制 表符（Chr(9)） ，对列进行分隔。 第 9 行代码，iRow 循环中在读取下一行单元格内容赋给变量 myMsg 时插入一个换行 符（Chr(10)） ，对行进行换行。 运行 Outmsbox 过程将用消息框显示当前工作表中 A1 至 E11 单元格区域中的内容， 并7VBA 常用技巧代码解析yuanzhuping排列整齐，如图 1-8 所示。图 1-8分列显示数据的消息框技巧2 技巧 自动关闭的消息框在程序执行完毕后给用户一个提示信息，但用 MsgBox 函数显示的消息框将一直保持， 需要用户单击“确定”或“关闭”按钮才会关闭。如果希望显示的消息框自动关闭，那么可 以使用以下方法显示消息框。 2-1 使用 WshShell.Popup 方法显示消息框 方法显示消息框#001 Sub WshShell() #002 #003 #004 #005 Dim WshShell As Object Set WshShell = CreateObject(&Wscript.Shell&) WshShell.popup &执行完毕!&, 2, &提示&, 64 Set WshShell = Nothing#006 End Sub代码解析： WshShell 过程使用 WshShell.Popup 方法显示消息框，2 秒后自动关闭。 WshShell.Popup 方法的语法如下：WshShell.Popup(strText, [natSecondsToWait], 8 [strTitle], [natType]) =VBA 常用技巧代码解析yuanzhupingintButton参数 strText 是必需的，与 Msgbox 的 Prompt 参数类似，代表在消息框中作为信息显 示的字符或字符串。如果显示的内容超过一行，可以在每一行之间用换行符 （Chr(10)）等 将各行分隔开来。 参数 natSecondsToWait 是可选的，其时间单位为妙。如果提供 natSecondsToWait 参 数且其值大于零，则消息框在 natSecondsToWait 参数指定的秒数后关闭。 参数 strTitle 是可选的，代表在消息框标题栏中作为标题的字符或字符串，若省略，则 窗口标题为“Windows 脚本宿主” 。 参数 natType 是可选的，指定消息框中显示按钮的数目及类型、使用的图标样式、缺省 按钮以及消息框的强制回应等，与 MsgBox 函数 buttons 参数相同，请参阅技巧 1-2 中的表 格 1-1。 参数 intButton 指示用户所单击的按扭编号，与 MsgBox 函数的返回值相同，请参阅技 巧 1-3 中的表格 1-2。若用户在 natSecondsToWait 秒之前不单击按扭，则返回值为 -1 。 运行 WshShell 过程显示一个如图 2-1 所示消息框，无需点击“确定”按纽，2 秒后自 动关闭。图 2-1自动关闭的消息框2-2 使用 API 函数显示消息框 使用 API 函数也可以达到这一效果，如下面的代码所示。#001 Public Declare Function SetTimer Lib &user32& ( _ #002 #003 #004 #005 ByVal hWnd As Long, _ ByVal nIDEvent As Long, _ ByVal uElaspe As Long, _ ByVal lpTimerFunc As Long) As Long#006 Public Declare Function KillTimer Lib &user32& ( _ #007 #008 #009 ByVal hWnd As Long, _ ByVal nIDEvent As Long) As Long Dim TID As Long#010 Sub Test() 9VBA 常用技巧代码解析yuanzhuping#011 #012TID = SetTimer(0, 0, 2000, AddressOf CloseTest) MsgBox &执行完毕!&#013 End Sub #014 Sub CloseTest(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idevent As Long, _ #015 #016 #017 ByVal Systime As Long) Application.SendKeys &~&, True KillTimer 0, TID#018 End Sub代码解析： 第 1 行代码到第 9 行代码是 API 函数声明。 Test 过程显示一个消息框并在 3 秒钟后运行 CloseTest 过程。 CloseTest 过程发送一个确定键给 Excel 程序关闭显示的消息框。 运行 Test 过程显示一个如图 2-2 所示的消息框并在 2 秒钟后关闭。图 2-2自动关闭的消息框技巧3 技巧使用 InputBox 函数3-1 简单的数据输入 Excel 的使用过程中，有时需要用户输入简单的数据，此时可以使用 InputBox 函数显 示一个对话框，供用户在对话框中输入数据信息，如下面的代码所示。#001 Sub myInputBox() #002 #003 Dim sInt As String Dim r As Integer10VBA 常用技巧代码解析yuanzhuping#004 #005 #006 #007 #008 #009 #010r = Sheet1.Range(&A65536&).End(xlUp).Row sInt = InputBox(&请输入人员姓名：&) If Len(Trim(sInt)) & 0 Then Sheet1.Cells(r + 1, 1) = sInt Else MsgBox &您没有输入内容!& End If#011 End Sub代码解析： myInputBox 过程使用 InputBox 函数显示一个对话框供用户在对话框中输入数据， InputBox 函数显示一个对话框，等待用户输入正文或按下按钮，并返回包含文本框内容的 字符串，语法如下：InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])参数 prompt 是必需的，作为对话框消息出现的字符串表达式。 参数 title 是可选的，作为显示在对话框标题栏中的字符串表达式，如果省略 title 参数， 则在标题栏中显示“Microsoft Excel” 。 参数 default 是可选的，显示在文本框中的字符串表达式，在没有其它输入时作为缺省 值，如果省略 default 参数，则文本框为空。 参数 xpos 是可选的，指定对话框的左边与屏幕左边的水平距离。如果省略 xpos 参数， 则对话框会在水平方向居中。 参数 ypos 是可选的，指定对话框的上边与屏幕上边的距离。如果省略 ypos 参数，则 对话框被放置在屏幕垂直方向距下边大约三分之一的位置。 参数 helpfile 和参数 context 是可选的，为对话框提供上下文相关的帮助和编号，如果 提供了其中一个参数，则必须提供另一个参数，两者缺一不可。 第 5 行代码，使用 InputBox 函数显示一个提示用户输入邮政编码的对话框，其中“请 输入人员姓名： ”是必需的 prompt 参数，其他参数使用缺省值。 第 4 行代码，使用 Len 函数和 Trim 函数判断返回的去除空格后的字符串长度。如果字 符串长度大于零，说明用户单击了对话框的“确定”按钮，则将用户输入的数据写到工作表 的 A 列单元格。如果返回的是长度为零的字符串，说明用户单击了对话框的“取消”按钮， 则显示一条提示消息。 因为当用户单击对话框的“确定”按钮后，InputBox 函数返回包含文本框内容的字符 串，如果用户单击对话框的“取消”按钮则返回一个长度为零的字符串（&&） ，通过返回的 字符串长度可以判断用户做出的选择。 运行 sInput 过程将显示一个提示用户输入数据的对话框，如图 3-1 所示。11VBA 常用技巧代码解析yuanzhuping图 3-1InputBox 函数显示的对话框3-2 使用对话框输入密码 使用 InputBox 函数显示的对话框输入密码简单方便，但有个明显的缺陷，就是输入过 程中不能用占位符显示密码，不够安全。借助 API 函数可以在输入密码过程中以占位符“*” 号来显示密码，如下面的代码所示。#001 Public Declare Function FindWindow Lib &user32& Alias &FindWindowA&(ByVal lpClassName As String, ByVal lpWindowName As String) As Long #002 Public Declare Function FindWindowEx Lib &user32& Alias &FindWindowExA& (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long #003 Public Declare Function SendMessage Lib &user32& Alias &SendMessageA& (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long #004 Public Declare Function timeSetEvent Lib &winmm.dll& (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long #005 Public Declare Function timeKillEvent Lib &winmm.dll& (ByVal uID As Long) As Long #006 Public Declare Function GetTickCount Lib &kernel32& () As Long #007 Public Const EM_SETPASSWORDCHAR = &HCC #008 Public lTimeID As Long #009 Sub TimeProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long) #010 #011 #012 #013 #014 Dim hwd As Long hwd = FindWindow(&#32770&, &密码&) If hwd && 0 Then hwd = FindWindowEx(hwd, 0, &edit&, vbNullString) SendMessage hwd, EM_SETPASSWORDCHAR, 42, 0 12VBA 常用技巧代码解析yuanzhuping#015 #016 #017timeKillEvent lTimeID End If End Sub#018 Sub Password() #019 #020 #021 #022 #023 #024 #025 #026 Dim Password As Variant lTimeID = timeSetEvent(10, 0, AddressOf TimeProc, 1, 1) Password = InputBox(&请输入密码：&, &密码&) If Password = &123456& Then MsgBox &密码正确!& Else MsgBox &密码错误!& End If#027 End Sub代码解析： Password 过程使用 InputBox 函数显示一个输入密码的对话框，并且以占位符“*”号 显示输入的密码。 第 1 行到第 8 行代码，API 函数声明。 第 9 行到第 17 行代码， TimeProc 过程是 timeSetEvent 的回调函数， 获得对话框句柄。 第 18 行到第 27 行代码，Password 过程显示一个提示用户输入密码的对话框。 运行 Password 过程将显示一个密码输入框， 输入的密码以占位符 “*” 号代替， 如图 3-2 所示。图 3-2密码输入框13VBA 常用技巧代码解析yuanzhuping技巧4 使用 InputBox 方法 技巧在 Excel 中输入简单的数据可以使用 InputBox 函数显示的对话框，但是如果输入的数 据类型不匹配时，过程运行时会产生意外错误。为了避免此类情况发生，可以使用另一种获 得用户输入的方式――InputBox 方法。 4-1 输入指定类型的数据 使用 InputBox 方法输入数据时可以指定数据的类型，如下面的代码所示。#001 Sub dInput() #002 #003 #004 #005 #006 #007 #008 #009 #010 Dim dInput As Double Dim r As Integer r = Sheet1.Range(&A65536&).End(xlUp).Row dInput = Application.InputBox(Prompt:=&请输入数字：&, Type:=1) If dInput && False Then Sheet1.Cells(r + 1, 1).Value = dInput Else MsgBox &你已取消了输入!& End If#011 End Sub代码解析： dInput 过程使用 InputBox 方法显示一个提示用户输入数字的对话框。 InputBox 方法显示一个接收用户输入的对话框，返回此对话框中输入的信息，语法如 下：expression.InputBox(Prompt, HelpContextId, Type) Title, Default, Left, Top, HelpFile,参数 expression 是必需的，返回一个 Application 对象。 参数 Prompt 是必需的，作为对话框消息显示的字符串表达式。 参数 Title 是可选的， 作为显示在对话框标题栏中的字符串表达式。 如果省略 Title 参数， 将使用默认的标题。 参数 Default 是可选的，在对话框显示时出现在文本框中的初始值。如果省略 Default 参数，则文本框为空。 参数 Left 是可选的，指定对话框相对于屏幕左上角的 x 坐标。14VBA 常用技巧代码解析yuanzhuping参数 Top 是可选的，指定对话框相对于屏幕左上角的 y 坐标。 参数 HelpFile 和参数 HelpContextId 是可选的， 为对话框提供上下文相关的帮助和编号， 如果提供了其中一个参数，则必须提供另一个参数，两者缺一不可。 参数 Type 是可选的，指定返回的数据类型。如果省略 Type 参数，对话框将返回文本。 InputBox 方法的语法和 InputBox 函数的语法相似，最大的区别在于最后一个参数―― Type。通过 Type 参数可以指定返回值的数据类型，表格 4-1 列出了 Type 参数可以使用的 数值。数值 0 1 2 4 8 16 64 期望的返回值 一个公式 一个数字 文本（字符串） 一个逻辑值，例如 true 或 false 一个单元格引用 一个错误值 一个值的数组表格 4-1 Type 参数的值这些数值可以相加使用，如果希望返回数字和文本，可以将 Type 参数设置为 1+2。 InputBox 方法与 InputBox 函数相比， 优点是内置的出错处理。 在第 5 行代码中将 Type 参数值设置为 1，这意味着对话框只能输入数值。当用户输入的不是数值时，显示一个如图 4-1 所示的消息框提示输入错误。图 4-1提示输入错误第 6 行到第 10 行代码，如果用户单击对话框的“确定”按钮，将用户输入的数字写入 工作表的 A 列单元格。如果用户单击对话框的“取消”按钮，则显示一条提示消息。 InputBox 方法和 InputBox 函数的另一个区别是， 当用户单击 “取消” 按纽时返回 False 而不是长度为零的字符串。 运行 dInput 过程将显示一个提示用户输入数字的对话框，如图 4-2 所示。15VBA 常用技巧代码解析yuanzhuping图 4-2InputBox 方法显示的对话框注意 在 VBA 代码中， Application.InputBox 调用的是 InputBox 方法， 不带对象识别符 的 InputBox 调用的是 InputBox 函数。 4-2 获得单元格区域地址 InputBox 方法很适合用户选择工作表单元格区域，并对所选择的单元格区域进行操作， 如下面的代码所示。#001 Sub RngInput() #002 #003 #004 8) #005 rng.Interior.ColorIndex = 15 Dim rng As Range On Error GoTo line Set rng = Application.InputBox(&请使用鼠标选择单元格区域：&, , , , , , ,#006 line: #007 End Sub代码解析： RngInput 过程使用 InputBox 方法显示一个对话框，提示用户在工作表中选择一个单元 格区域，并改变所选单元格区域内部的颜色。 第 3 行代码，错误处理语句。因为当对话框显示后，如果用户单击“取消”按钮，将显 示一错误信息，如图 4-3 所示，所以必需使用 On Error GoTo 语句来绕过错误。16VBA 常用技巧代码解析yuanzhuping图 4-3提示运行错误第 4 行代码，使用 Set 语句将用户选择的单元格区域赋给变量 rng。当 Type 参数设置 为 8 时，将返回一个 Range 对象，必须用 Set 语句将结果指定给一个 Range 对象。 第 5 行代码，改变用户所选单元格区域内部的颜色。 运行 RngInput 过程，将显示一个对话框，提示用户在工作表中选择一个单元格区域， 并改变所选单元格区域内部的颜色，如图 4-4 所示。图 4-4使用 InputBox 方法获得区域地址技巧5 技巧内置对话框5-1 调用内置的对话框17VBA 常用技巧代码解析yuanzhuping如果需要使用“打开”“打印”等 Excel 内置对话框已经具有的功能，可以使用代码直 、 接调用这些内置的对话框，如下面的代码所示。#001 Sub DialogOpen() #002 &\*.xls& #003 End Sub Application.Dialogs(xlDialogOpen).Show arg1:=ThisWorkbook.Path &代码解析： DialogOpen 过程显示内置的“打开”对话框并选定示例所在的文件夹。 显示内置对话框语法如下：Application.Dialogs(xlDialogConst).ShowDialogs 集合代表所有的内置对话框，每个 Dialog 对象代表一个内置对话框，不能新建 内置对话框或向该集合中添加内置对话框。 参数 xlDialogConst 是内置对话框的内置常量，每个常量都以“xlDialog”开头，其后 是对话框的名称，如“打开”对话框的常量为“xlDialogOpen” 。常用内置对话框的内置常 量如表格 5-1 所示。常量 xlDialogActiveCellFont xlDialogBorder xlDialogCellProtection xlDialogDeleteFormat xlDialogFormatNumber xlDialogPatterns xlDialogClear xlDialogColumnWidth xlDialogRowHeight xlDialogConditionalFormatting xlDialogDefineName xlDialogDefineStyle xlDialogDisplay xlDialogFont xlDialogSetBackgroundPicture xlDialogInsert xlDialogInsertHyperlink xlDialogInsertPicture 值 476 45 46 111 42 84 52 47 127 583 61 229 27 26 509 55 596 342 说明 单元格格式(字体） 单元格格式(边框） 单元格格式(保护） 单元格格式(数字） 单元格格式(数字） 单元格格式(图案） 清除 列宽 行高 条件格式 定义名称 样式 显示选项 字体 工作表背景 插入 插入超链接 插入图片18VBA 常用技巧代码解析yuanzhupingxlDialogNew xlDialogOpen xlDialogSaveAs xlDialogWorkbookCopy xlDialogWorkbookInsert xlDialogWorkbookMove xlDialogWorkbookName xlDialogWorkbookNew xlDialogWorkbookProtect xlDialogPageSetup xlDialogPrint xlDialogPrinterSetup xlDialogPrintPreview xlDialogSetPrintTitles xlDialogRun xlDialogTable xlDialogSendMail119 1 5 283 354 282 386 302 417 7 8 9 222 23 17 41 189新建工作簿 打开 另存为 移动或复制工作表（建立副本） 插入工作表 移动或复制工作表 重命名工作表 新建工作表 保护工作簿 页面设置 打印内容 打印机设置 打印预览 设置打印标题 宏 模拟运算表 发送邮件表格 5-1 内置对话框的内置常量显示内置对话框使用 Show 方法，应用于 Dialog 对象的 Show 方法语法如下：expression.Show(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30)参数 expression 是必需的，返回 Dialog 对象之一。 参数 arg1 到参数 arg30 是可选的，仅应用于内置对话框，是命令的初始参数。若要查 找要设置的参数，请在内置对话框参数列表中查找对应的对话框常量。 运行 alogOpen 过程，显示内置的“打开”对话框，并且直接选定示例所在的文件夹， 如图 5-1 所示。19VBA 常用技巧代码解析yuanzhuping图 5-1使用内置对话框5-2 获取选定文件的文件名 获取选定文件的 选定文件的文件名 如果只希望获取用户在显示的内置 “打开”对话框中选定文件的文件名，而不想真正 打开该文件，那么可以使用 GetOpenFilename 方法，如下面的代码所示。#001 Sub OpenFilename() #002 #003 #004 #005 Dim Filename As Variant Dim mymsg As Integer Dim i As Integer Filename = Application.GetOpenFilename(Title:=& 删 除 文 件 &,MultiSelect:=True) #006 #007 #008 #009 #010 #011 #012 #013 If IsArray(Filename) Then mymsg = MsgBox(&是否删除所选文件?&, vbYesNo, &提示&) If mymsg = vbYes Then For i = 1 To UBound(Filename) Kill Filename(i) Next End If End If#014 End Sub代码解析：20VBA 常用技巧代码解析yuanzhupingOpenFilename 过程使用 GetOpenFilename 方法显示标准的内置“打开”对话框，获 取用户选定文件的文件名后使用 Kill 语句删除。 GetOpenFilename 方法显示标准的内置“打开”对话框，获取文件名，语法如下：expression.GetOpenFilename(FileFilter, MultiSelect) FilterIndex, Title, ButtonText,参数 expression 是必需的，返回一个 Application 对象。 参数 FileFilter 是可选的，指定文件筛选条件的字符串。如果省略，则默认参数值为“所 有文件(*.*)” 。 参数 FilterIndex 是可选的，指定默认文件筛选条件的索引号，取值范围为 1 到由 FileFilter 所指定的筛选条件数目。如果省略，或者取值大于可用筛选数目，则采用第一个 文件筛选条件。 参数 Title 是可选的，指定对话框的标题。如果省略，则使用“打开”作为标题。 参数 ButtonText 是可选的，仅用于 Macintosh。 参数 MultiSelect 是可选的，如果该值为 True，则允许选定多个文件名，如果该值为 False，则只允许选定单个文件名。默认值为 False。 第 5 行代码显示标准的“打开”对话框，将对话框的标题设置为“删除文件” ，将 MultiSelect 参数设置为 True，允许选定多个文件。 第 6 行代码，获得返回值。当用户选定文件后，返回的是选定的文件名或用户输入的文 件名。因为 MultiSelect 参数已设置为 True，所以返回值将是一个包含所有选定文件名的数 组（即使仅选定了一个文件名） 。如果用户取消了对话框，则该值为 False。 第 8 行到第 12 行代码，经询问用户后使用 Kill 语句从磁盘中删除用户选定的文件。 运行 OpenFilename 过程，显示标准的内置“打开”对话框，删除用户选定的文件，如 所图 5-2 示。21VBA 常用技巧代码解析yuanzhuping图 5-2获取用户选定文件的文件名注意 VBA 中数组下界默认从 0 开始，但使用 GetOpenFilename 方法选择多个文件时 返回的包含选定文件名的数组下界是从 1 开始。 5-3 使用“另存为”对话框 使用“另存为” 在备份文件时可以使用 GetSaveAsFilename 方法显示标准的内置“另存为”对话框， 获取备份文件的文件名和保存路径，而无须真正保存任何文件。如下面的代码所示。#001 Sub CopyFilename() #002 #003 #004 #005 #006 #007 #008 #009 #010 #011 #012 #013 #014 #015 #016 #017 #018 #019 Dim NowWorkbook As Workbook Dim FileName As String On Error GoTo line FileName = Application.GetSaveAsFilename _ (InitialFileName:=&D:\& & Date & & & & ThisWorkbook.Name, _ fileFilter:=&Excel files(*.xls),*.xls,All files (*.*),*.*&, _ Title:=&数据备份&) If FileName && &False& Then Set NowWorkbook = Workbooks.Add With NowWorkbook .SaveAs FileName ThisWorkbook.Sheets(&Sheet2&).UsedRange.Copy _ .Sheets(&Sheet1&).Range (&A1&) .Save End With GoTo line End If Exit Sub#020 line: #021 ActiveWorkbook.Close#022 End Sub代码解析： CopyFilename 过程使用 GetSaveAsFilename 方法显示标准的内置“另存为”对话框，22VBA 常用技巧代码解析yuanzhuping获取备份文件的文件名和保存路径，新建工作簿保存备份数据。 第 4 行代码，错误处理语句。备份过程中，如果已存在同名工作簿，会出现如图 5-3 所示的提示，如果选择了“否” ，此时新工作簿已经建立，在执行第 12 行代码时发生错误， 使程序中断，所以使用 GoTo 语句执行第 21 行代码，关闭新建立的工作簿。图 5-3文件已存在提示第 5 行代码，使用 GetSaveAsFilename 方法显示标准的内置“另存为”对话框。 GetSaveAsFilename 方法的语法如下：expression.GetSaveAsFilename(InitialFilename, Title, ButtonText) FileFilter, FilterIndex,参数 expression 是必需的，返回一个 Application 对象。 参数 InitialFilename 是可选的，指定建议的文件名。如果省略，将活动工作簿的名称作 为建议的文件名。 参数 FileFilter 是可选的，指定文件筛选条件的字符串。 参数 FilterIndex 是可选的，指定默认文件筛选条件的索引号，取值范围为 1 到 FileFilter 指定的筛选条件数目之间。如果省略，或者取值大于可用筛选数目，则采用第一 个文件筛选条件。 参数 Title 是可选的，指定对话框标题。如果省略，则使用默认标题。 参数 ButtonText 是可选的，仅用于 Macintosh。 第 6 行代码，设置对话框的保存路径为 D 盘，保存文件名为日期加工作簿名称。 第 7 行代码， 设置对话框文件保存类型为 Excel 文件类型。 如果需要设置为文本类型需 设置为“文本文件(*.txt), *.txt” ，而如果是图片文件则需设置为“图片文件(*.*.jpg),**.jpg” 。 第 8 行代码，设置对话框的标题为“数据备份” 。 第 9 行代码，如果用户没有取消操作。 第 10 行到第 16 行代码，使用 Add 方法新建工作簿保存到对话框选定的路径中，将数 据备份到新工作簿中。 第 17 行代码，使用 GoTo 语句执行第 21 行代码，关闭新建工作簿和开启屏幕刷新。 运行 CopyFilename 过程，显示内置“另存为”对话框，供用户备份工作簿数据，如图 5-4 所示。23VBA 常用技巧代码解析yuanzhuping图 5-4使用“另存为”对话框备份文件技巧6 调用操作系统“关于” 技巧 调用操作系统“关于”对话框VBA 程序开发完成后，有时需要一个“关于”对话框，除了使用窗体外，还可以调用 操作系统的“关于”对话框，显示自定义的内容，如下面的代码所示。#001 Private Declare Function ShellAbout Lib &shell32.dll& Alias&ShellAboutA& ( _ #002 #003 ByVal hwnd As Long, ByVal szApp As String, _ ByVal szOtherStuff As String, ByVal hIcon As Long) As Long#004 Private Declare Function FindWindow Lib &user32& Alias &FindWindowA& ( _ #005 ByVal lpClassName As String, ByVal lpWindowName As String) As Long#006 Private Sub CommandButton1_Click() #007 #008 #009 Dim ApphWnd As Long ApphWnd = FindWindow(&XLMAIN&, Application.Caption) ShellAbout ApphWnd, & 财 务 处 理 系 统 &, &0&, 024VBA 常用技巧代码解析yuanzhuping#010 End Sub代码解析： 第 1 行到第 5 行代码是 API 函数声明。 第 8、9 行代码调用操作系统的“关于”对话框并显示自定义的内容。 代码运行后显示如图 6-1 所示的对话框。图 6-1调用操作系统的“关于”对话框25VBA 常用技巧代码解析yuanzhuping第2章 菜单和工具栏 章技巧7 技巧 在菜单中添加菜单项在 Excel 工作表的菜单中可以添加新的菜单项和子菜单，如下面的代码所示。#001 Sub myTools() #002 #003 #004 #005 #006 数据透视表&) #007 #008 #009 #010 myid = Array(281, 283, 285, 287, 292) With Application.CommandBars(&Worksheet menu bar&) .Reset Set myTools = .Controls(& 帮 助 Dim myTools As CommandBarPopup Dim myCap As Variant Dim myid As Variant Dim i As Byte myCap = Array(&基础应用&, &VBA 程序开发&, &函数与公式&, &图表与图形&, &(&H)&).Controls.Add(Type:=msoControlPopup, Before:=1) #011 #012 #013 #014 #015 #016 #017 #018 #019 #020 #021 With myTools .Caption = &Excel Home 技术论坛& .BeginGroup = True For i = 1 To 5 With .Controls.Add(Type:=msoControlButton) .Caption = myCap(i - 1) .FaceId = myid(i - 1) .OnAction = &myC& End With Next End With 26VBA 常用技巧代码解析yuanzhuping#022 #023End With Set myTools = Nothing#024 End Sub代码解析： myTools 过程使用 Add 方法在 Excel 工作表菜单栏中的“帮助”菜单中添加一个标题 为“Excel Home 技术论坛”的菜单项和 5 个子菜单。 第 2 行到第 5 行代码声明变量类型。 第 6、7 行代码使用 Array 函数创建两个数组用于保存子菜单的名称和图标 ID。 第 9 行代码， 在添加菜单项前先使用 Reset 方法重置菜单栏以免重复添加菜单项。 Reset 方法重置一个内置控件，恢复该控件原来对应的动作，并将各属性恢复成初始状态，语法如 下：expression.Reset参数 expression 是必需的，返回一个命令栏或命令栏控件对象。 第 10 行代码，使用 Add 方法在 Excel 工作表菜单栏中的“帮助”菜单中添加菜单项。 Add 方法应用于 CommandBarControls 对象时，新建一个 CommandBarControl 对象并添 加到指定命令栏上的控件集合，语法如下：expression.Add(Type, Id, Parameter, Before, Temporary)参数 expression 是必需的，返回一个 CommandBarControls 对象，代表命令栏中的所 有控件。 参数 Type 是可选的，添加到指定命令栏的控件类型，可以为表格 7-1 所列的 MsoControlType 常数之一。常数 msoControlButton msoControlEdit msoControlDropdown msoControlComboBox msoControlPopup 值 1 2 3 4 10 控件类型 命令按钮 文本框 下拉列表控制框 下拉组合控制框 弹出式控件表格 7-1 MsoControlType 常数因为在本例中将添加的是带有子菜单的菜单项，所以将参数 Type 设置为弹出式控件。 参数 Id 是可选的，标识整数。如果将该参数设置为 1 或者忽略，将在命令栏中添加一 个空的指定类型的自定义控件。 参数 Parameter 是可选的，对于内置控件，该参数用于容器应用程序运行命令。对于 自定义控件，可以使用该参数向 Visual Basic 过程传递信息，或用其存储控件信息。27VBA 常用技巧代码解析yuanzhuping参数 Before 是可选的，表示新控件在命令栏上位置的数字。新控件将插入到该位置控 件之前。如果忽略该参数，控件将添加到指定命令栏的末端。本例中将 Before 参数设置为 1，菜单项添加到“帮助”菜单的顶端。 参数 Temporary 是可选的。设置为 True 将使添加的菜单项为临时的，在关闭应用程序 时删除。默认值为 False。 第 12 行代码， 设定新添加菜单项的 Caption 属性为 “Excel Home 技术论坛” Caption 。 属性返回或设置命令栏控件的标题。 第 13 行代码，设置新添加菜单项的 BeginGroup 属性为 True，分组显示。 第 14 行到第 19 行代码，在“Excel Home 技术论坛”菜单项上添加五个子菜单并设 置其 Caption 属性、FaceId 属性和 OnAction 属性。 FaceId 属性设置出现在菜单标题左侧的图标，以数字表示，一个数字代表一个内置的 图标。 OnAction 属性设置一个 VBA 的过程名，该过程在用户单击子菜单时运行，本例中设置 为下面的过程。#001 Public Sub myC() #002 MsgBox &您选择了： & & Application.CommandBars.ActionControl.Caption#003 End Sub代码解析： myC 过程是单击新添加子菜单所运行过程，为了演示方便在这里只使用 MsgBox 函数 显示所其 Caption 属性。 删除新添加的菜单项及子菜单的代码如下所示。#001 Sub DelmyTools() #002 Application.CommandBars(&Worksheet menu bar&).Reset#003 End Sub代码解析： DelmyTools 过程使用 Reset 方法重置菜单栏，删除添加的菜单项及子菜单。 为了在打开工作簿时自动添加菜单项，需要在工作簿的 Activate 事件中调用 myTools 过程，如下面的代码所示。#001 Private Sub Workbook_Activate() #002 Call myTools#003 End Sub为了在关闭工作簿时删除新添加的菜单项，还需要在工作簿的 Deactivate 事件中调用 DelmyTools 过程，如下面的代码所示。28VBA 常用技巧代码解析yuanzhuping#001 Private Sub Workbook_Deactivate() #002 Call DelmyTools#003 End Sub如果希望这个菜单为所有工作簿使用，那么就应该在工作簿的 Open 事件中调用 myTools 过程，在 BeforeClose 事件中调用 DelmyTools 过程。 运行 myTools 过程， 将在 Excel 工作表菜单栏中的 “帮助” 菜单中添加一个名为 “Excel Home 技术论坛”的菜单项及五个子菜单，如图 7-1 所示。图 7-1在“帮助”菜单中添加菜单项及子菜单技巧8 菜单栏指定位置添加菜单 技巧 在菜单栏指定位置添加菜单除了可以在工作表菜单中添加菜单项外，还可以在工作表菜单栏的指定位置添加菜单， 如下面的代码所示。#001 Sub AddNewMenu() #002 #003 #004 #005 #006 #007 #008 #009 #010 Dim HelpMenu As CommandBarControl Dim NewMenu As CommandBarPopup With Application.CommandBars(&Worksheet menu bar&) .Reset Set HelpMenu = .FindControl(ID:=.Controls(&帮助(&H)&).ID) If HelpMenu Is Nothing Then Set NewMenu = .Controls.Add(Type:=msoControlPopup) Else Set NewMenu = .Controls.Add(Type:=msoControlPopup, _29VBA 常用技巧代码解析yuanzhuping#011 #012 #013 #014 #015 #016 #017 #018 #019 #020 #021 #022 #023 #024 #025 #026 #027 #028 End IfBefore:=HelpMenu.Index)With NewMenu .Caption = &统计(&S)& With .Controls.Add(Type:=msoControlButton) .Caption = &输入数据(&D)& .FaceId = 162 .OnAction = && End With With .Controls.Add(Type:=msoControlButton) .Caption = &汇总数据(&T)& .FaceId = 590 .OnAction = && End With End With End With Set HelpMenu = Nothing Set NewMenu = Nothing#029 End Sub代码解析： AddNewMenu 过程使用 Add 方法在工作表“帮助”菜单前添加一个标题为“统计”的 菜单和两个菜单项。 第 6 行代码，使用 FindControl 方法在工作表菜单栏中查找“帮助”菜单。应用于 CommandBars 对象的 FindControl 方法返回一个符合指定条件的 CommandBarControl 对 象。语法如下：expression.FindControl(Type, Id, Tag, Visible, Recursive)参数 expression 是必需的，返回一个 CommandBars 对象。 参数 Type 是可选的，要查找控件的类型。 参数 Id 是可选的，要查找控件的标识符。 参数 Tag 是可选的，要查找控件的标记值。 参数 Visible 是可选，如果该值为 True，那么只查找屏幕上显示的命令栏控件。默认值 为 False。30VBA 常用技巧代码解析yuanzhuping参数 Recursive 是可选的，如果该值为 True，那么将在命令栏及其全部弹出式子工具 栏中查找。此参数仅应用于 CommandBar 对象。默认值为 False。 如果没有控件符合搜索条件，那么 FindControl 方法返回 Nothing。 第 7 行到第 12 行代码，如果工作表菜单栏中存在“帮助”菜单，将“统计”菜单添加 到“帮助”菜单之前，否则添加到工作表菜单栏末尾。 第 12 行到第 25 行代码，在“统计”菜单中添加两个子菜单并设置其各种属性。 运行 AddNewMenu 过程，将在工作表菜单栏的“帮助”菜单之前添加一个“统计”菜 单，如图 8-1 所示。图 8-1在工作表菜单栏中添加菜单技巧9 屏蔽和删除工作表菜单 技巧 屏蔽和删除工作表菜单如果不希望用户使用工作表菜单栏的部分功能， 可以把菜单或菜单项屏蔽或删除， 如下 面的代码所示。#001 Sub Shibar() #002 #003 #004 #005 #006 With Application.CommandBars(&Worksheet menu bar&) .Reset .Controls(&工具(&T)&).Controls(&宏(&M)&).Enabled = False .Controls(&数据(&D)&).Delete End With#007 End Sub代码解析： Shibar 过程屏蔽 “工具”菜单中的“宏”菜单项，删除菜单栏中的“数据”菜单。 第 3 行代码，使用 Reset 方法重置工作表菜单栏。 第 4 行代码，将“宏”菜单项的 Enabled 属性设置为 False，使之无效。 Enabled 属性决定命令栏或命令栏控件是否激活，如果将该属性设置为 False，那么该31VBA 常用技巧代码解析yuanzhuping菜单项将无效。 第 5 行代码，使用 Delete 方法将“数据”菜单从工作表菜单栏中删除。 Delete 方法应用于命令栏或命令栏控件时，从集合中删除指定对象，语法如下：expression.Delete(Temporary)参数 expression 是必需的，返回命令栏或命令栏控件对象之一。 参数 Temporary 是可选的，设置为 True 将从当前会话中删除控件，应用程序在下次会 话时将再次显示控件。 运行 Shibar 过程，将屏蔽工作表“工具”菜单中的“宏”菜单项和删除工作表菜单栏 中的“数据”菜单，如图 9-1 所示。图 9-1屏蔽和删除工作表菜单技巧10 技巧改变系统菜单的操作利用 VBA 甚至可以改变系统菜单的默认操作，使之达到自定义菜单的效果，如下面的 代码所示。#001 Dim WithEvents Saveas As CommandBarButton #002 Private Sub Workbook_Open() #003 (&A)...&) #004 End Sub #005 Private Sub Saveas_Click(ByVal Ctrl As Office.CommandBarButton, Set Saveas = Application.CommandBars(&File&).Controls(& 另 存 为CancelDefault As Boolean) #006 #007 CancelDefault = True MsgBox &本工作簿禁止另存!&#008 End Sub32VBA 常用技巧代码解析yuanzhuping代码解析： 第 1 行代码，在模块级别中使用关键词 WithEvents 声明变量 Saveas 是用来响应由 CommandBarButton 对象触发事件的对象变量。 第 2 行到第 4 代码工作簿的 Open 事件过程， 在工作簿打开时将变量 Saveas 赋值为系 统菜单的“另存为”菜单。 因为在声明变量 Saveas 时使用了关键词 WithEvents，不能同时使用 New 关键词隐式 地创建对象， 所以在使用变量 Saveas 之前， 必须使用 Set 语句将变量赋值为一个已有对象。 第 5 行到第 8 代码变量 Saveas 的单击事件过程， 改变系统菜单 “另存为” 的默认操作。 变量 Saveas 的 Click 事件在用户单击系统菜单“另存为”时发生，语法如下：Private Sub CommandBarButton_Click(ByVal Ctrl As CommandBarButton, ByVal CancelDefault As Boolean)参数 Ctrl 是必需的，指示初始化该事件的 CommandBarButton 控件。 参数 CancelDefault 是必需的，Boolean 类型，如果执行了与 CommandBarButton 控 件关联的默认操作，该值为 False。除非其他过程或加载项取消了此操作。 第 6、7 行代码，将 CancelDefault 参数设置为 True，使单击“另存为”菜单时并不执 行默认操作而只显示一个消息框。 将工作簿保存、关闭后，重新打开，单击“另存为”菜单并不执行默认操作，只显示一 个消息框，如图 10-1 所示。图 10-1 改变系统菜单的默认操作技巧11 技巧定制自己的系统菜单使用 VBA 开发的小型应用系统完成后，Excel 原有的菜单栏完全可以舍弃不用，只使 用自定义的菜单栏，更加方便快捷，如下面的代码所示。#001 Sub AddNowBar() #002 Dim NewBar As CommandBar 33VBA 常用技巧代码解析yuanzhuping#003 #004 #005 #006 #007 #008 #009 #010 #011 #012 #013On Error Resume Next With Application .CommandBars(&Standard&).Visible = False .CommandBars(&Formatting&).Visible = False .CommandBars(&Stop Recording&).Visible = False .CommandBars(&toolbar list&).Enabled = False .CommandBars.DisableAskAQuestionDropdown = True .DisplayFormulaBar = False .CommandBars(&NewBar&).Delete End With Set NewBar = Application.CommandBars.Add(Name:=&NewBar&,Position:=msoBarTop, MenuBar:=True, Temporary:=True) #014 #015 #016 #017 #018 #019 #020 #021 #022 #023 #024 #025 #026 #027 #028 #029 #030 #031 #032 #033 With NewBar .Visible = True With .Controls.Add(Type:=msoControlPopup) .Caption = &系统设置(&X)& .BeginGroup = True With .Controls.Add(Type:=msoControlButton) .Caption = &保存(&S)& .BeginGroup = True .FaceId = 1975 End With With .Controls.Add(Type:=msoControlButton) .Caption = &备份(&B)& .BeginGroup = True .FaceId = 747 End With End With With .Controls.Add(Type:=msoControlPopup) .Caption = &会计凭证(&P)& .BeginGroup = True With .Controls.Add(Type:=msoControlButton)34VBA 常用技巧代码解析yuanzhuping#034 #035 #036 #037 #038 #039 #040 #041 #042 #043 #044 #045 #046 #047 #048 #049 #050 #051 #052 #053 #054 #055 #056 #057 #058 #059 #060 #061 #062 #063 #064 #065.Caption = &录入(&L)& .BeginGroup = True .FaceId = 197 End With With .Controls.Add(Type:=msoControlButton) .Caption = &审核(&S)& .BeginGroup = True .FaceId = 714 End With End With With .Controls.Add(Type:=msoControlPopup) .Caption = &会计账簿(&Z)& .BeginGroup = True With .Controls.Add(Type:=msoControlButton) .Caption = &记账(&L)& .BeginGroup = True .FaceId = 65 End With With .Controls.Add(Type:=msoControlButton) .Caption = &结账(&S)& .BeginGroup = True .FaceId = 47 End With End With With .Controls.Add(Type:=msoControlPopup) .Caption = &会计报表(&B)& .BeginGroup = True With .Controls.Add(Type:=msoControlPopup) .Caption = &资产负债表(&Y)& .BeginGroup = True With .Controls.Add(Type:=msoControlButton) .Caption = &月报(&M)& 35VBA 常用技巧代码解析yuanzhuping#066 #067 #068 #069 #070 #071 #072 #073 #074 #075 #076 #077 #078 #079 #080 #081 #082 #083 #084 #085 #086 #087 #088 #089 #090 #091 #092 #093 #094 #095 #096.BeginGroup = True .FaceId = 1180 End With With .Controls.Add(Type:=msoControlButton) .Caption = &年报(&Y)& .BeginGroup = True .FaceId = 1188 End With End With With .Controls.Add(Type:=msoControlPopup) .Caption = &损益表(&S)& .BeginGroup = True With .Controls.Add(Type:=msoControlButton) .Caption = &月报(&M)& .BeginGroup = True .FaceId = 1180 End With With .Controls.Add(Type:=msoControlButton) .Caption = &年报(&Y)& .BeginGroup = True .FaceId = 1188 End With End With End With With .Controls.Add(Type:=msoControlButton) .Caption = &退出系统(&C)& .BeginGroup = True .Style = msoButtonCaption End With End With Set NewBar = Nothing#097 End Sub 36VBA 常用技巧代码解析yuanzhuping代码解析： AddNowBar 过程使用 Add 方法创建自定义菜单栏替换工作表菜单栏。 第 2 行代码定义变量 NwBar 为命令栏。 第 3 行代码忽略错误语句，以免第 11 行代码在删除可能不存在的“NewBar”菜单栏 时发生错误。 第 5 行代码隐藏“常用”工具栏。 第 6 行代码隐藏“格式”工具栏。 第 7 行代码隐藏“停止录制”工具栏。 第 8 行代码屏蔽工具栏的右键快捷菜单。 第 9 行代码屏蔽工具栏的“键入需要帮助的问题”下拉框。 第 10 行代码屏蔽工具栏的编辑栏。 第 11 行代码，在添加命令栏前先删除“NewBar”菜单栏，以免重复增加。 第 13 行代码，使用 Add 方法创建命令栏。Add 方法应用于 CommandBars 对象的语 法如下：expression.Add(Name, Position, MenuBar, Temporary)参数 expression 是必需的，返回一个 CommandBars 对象，该对象代表应用程序中的 命令栏，新建命令栏的控件均以该对象为载体。 参数 Name 是可选的，设置新建命令栏的标题。如果忽略该参数，则为新建命令栏指 定默认标题，本例中设置新建命令栏的标题为“NewBar” 。 参数 Position 是可选的，设置新建命令栏的位置或类型，可以为表格 11-1 所列的 MsoBarPosition 常数之一。常数 msoBarLeft、msoBarTop、msoBarRight 和 msoBarBottom msoBarFloating msoBarPopup msoBarMenuBar 指定新命令栏不固定 指定新命令栏为快捷菜单 仅适用于 Macintosh 机 说明 指定新命令栏的左侧、顶部、右侧和底部坐标表格 11-1MsoBarPosition 常数本例中设置“NewBar”命令栏的 Position 参数为 msoBarTop，使“NewBar”命令栏 位于 Excel 窗口的顶部。 参数 MenuBar 是可选的， 设置为 True 将以新命令栏替换活动菜单栏， 默认值为 False。 在本例中，设置“NewBar”命令栏的 MenuBar 属性为 True，以“NewBar”命令栏替 换活动菜单栏。37VBA 常用技巧代码解析yuanzhuping参数 Temporary 是可选的，设置为 True 将使新建命令栏为临时命令栏，在关闭应用程 序时删除，默认值为 False。 在本例中，设置“NewBar”命令栏的 Temporary 属性为 True，使“NewBar”命令栏 为临时命令栏，在关闭应用程序时删除。 第 15 行代码，设置“NewBar”命令栏为可见的。 第 16 行到 95 行代码，使用 Add 方法在“NewBar”命令栏中添加菜单、菜单项及子菜 单并设置其各项属性，参阅技巧 7 。 恢复 Excel 原有的菜单栏的代码如下：#001 Sub DelNowBar() #002 #003 #004 #005 #006 #007 #008 #009 #010 #011 On Error Resume Next With Application .CommandBars(&Standard&).Visible = True .CommandBars(&Formatting&).Visible = True .CommandBars(&Stop Recording&).Visible = True .CommandBars(&toolbar list&).Enabled = True .CommandBars.DisableAskAQuestionDropdown = False .DisplayFormulaBar = True .CommandBars(&NewBar&).Delete End With#012 End Sub代码解析： DelNowBar 过程取消 “常用”“格式”和“停止录制”工具栏的的隐藏，恢复“键入 、 需要帮助的问题”下拉框和编辑栏，删除“NewBar”命令栏。 运行 AddNowBar 过程，工作表菜单栏如图 11-1 所示。图 11-1 定制自己的系统菜单38VBA 常用技巧代码解析yuanzhuping技巧12 技巧改变菜单按钮图标利用 VBA 可以改变系统菜单的默认图标，使之达到自定义按钮图标的效果，如下面的 代码所示。#001 Sub myCbarCnt() #002 #003 #004 #005 #006 #007 #008 #009 #010 Dim myCbarCnt As CommandBarControl With Sheet1.Shapes.AddShape(17, , 30, 30) .Fill.ForeColor.SchemeColor = 29 .CopyPicture .Delete End With Set myCbarCnt = Application.CommandBars(&Standard&).Controls(1) myCbarCnt.PasteFace Set myCbarCnt = Nothing#011 End Sub #012 Sub DelmyCbarCnt() #013 Application.CommandBars(&Standard&).Controls(1).Reset#014 End Sub代码解析： myCbarCnt 过程改变系统菜单的“新建”按钮的图标。 第 3 行代码使用 Shape 对象的 AddShape 方法在工作表中新建一个自选图形。应用于 Shape 对象的 AddShape 方法请参阅错误！未找到引用源。 错误！ 。 错误 未找到引用源。 在本例中将新建图形的 Left 参数和 Top 参数设置为较大的数值使新建的自选图形不在 当前窗口的可视区域内。 第 4 行代码设置新建自选图形的颜色。 第 5 行代码使用 CopyPicture 方法将新建自选图形作为图片复制到剪贴板。 CopyPicture 方法的语法如下：expression.CopyPicture(Appearance, Format)参数 expression 是必需的，一个有效的对象。 参数 Appearance 是可选的，指定图片的复制方式。 参数 Format 是可选的，图片的格式。 第 6 行代码使用 Delete 方法删除新建的自选图形。39VBA 常用技巧代码解析yuanzhuping第 8 行代码使用 Set 语句将系统菜单的“新建”按钮赋给变量 myCbarCnt。 第 9 行代码 PasteFace 方法将新建的自选图形粘贴到“新建”按钮中。PasteFace 方 法将“剪贴板”的内容粘贴到指定命令栏按钮控件上，语法如下：expression.PasteFace参数 expression 是必需的，返回一个 CommandBarButton 对象。 DelmyCbarCnt 过程使用 Reset 方法恢复“新建”按钮的默认图标。 运行 myCbarCnt 过程结果如图 12-1 所示。图 12-1 改变“新建”按钮的图标技巧13 技巧右键快捷菜单增加菜单项 右键快捷菜单增加菜单项 菜单在 Excel 的右键快捷菜单中可以添加新的菜单项，如下面的代码所示。#001 Sub MyCmb() #002 #003 #004 #005 #006 #007 #008 #009 Dim MyCmb As CommandBarButton With Application.CommandBars(&Cell&) .Reset Set MyCmb = .Controls.Add(Type:=msoControlButton, _ ID:=2521, Before:=.Controls.Count, Temporary:=True) MyCmb.BeginGroup = True End With Set MyCmb = Nothing#010 End Sub代码解析： MyCmb 过程使用 Add 方法在 Excel 的右键快捷菜单中添加内置的“打印”菜单项。 在使用 Add 方法添加菜单项时将 Id 参数设置为 2521，添加的就是内置的“打印”菜 单项。将 Before 属性设置成右键快捷菜单中最后一个控件的值，使“打印”菜单项添加到 右键快捷菜单中最后一个控件之前。将 Temporary 参数设置成 True，在关闭应用程序时从40VBA 常用技巧代码解析yuanzhuping右键快捷菜单中删除“打印”菜单项。 运行 MyCmb 过程，将在 Excel 右键快捷菜单中添加 “打印”菜单项，如图 13-1 所 示图 13-1 在右键快捷菜单中添加菜单项技巧14 技巧自定义右键快捷菜单 自定义右键快捷菜单在工作表中创建自定义的右键快捷菜单替换 Excel 默认的右键快捷菜单， 如下面的代码 所示。#001 Sub Mycell() #002 #003 #004 #005 #006 #007 With Application.CommandBars.Add(&Mycell&, msoBarPopup) With .Controls.Add(Type:=msoControlButton) .Caption = &会计凭证& .FaceId = 9893 End With With .Controls.Add(Type:=msoControlButton) 41VBA 常用技巧代码解析yuanzhuping#008 #009 #010 #011 #012 #013 #014 #015 #016 #017 #018 #019 #020 #021 #022 #023 #024 #025 #026 #027 #028 #029 #030 #031 #032 #033 #034 #035 #036 #037 #038 #039.Caption = &会计账簿& .FaceId = 284 End With With .Controls.Add(Type:=msoControlPopup) .Caption = &会计报表& With .Controls.Add(Type:=msoControlButton) .Caption = &月报& .FaceId = 9590 End With With .Controls.Add(Type:=msoControlButton) .Caption = &季报& .FaceId = 9591 End With With .Controls.Add(Type:=msoControlButton) .Caption = &年报& .FaceId = 9592 End With End With With .Controls.Add(Type:=msoControlButton) .Caption = &凭证打印& .FaceId = 9614 .BeginGroup = True End With With .Controls.Add(Type:=msoControlButton) .Caption = &账簿打印& .FaceId = 707 End With With .Controls.Add(Type:=msoControlButton) .Caption = &报表打印& .FaceId = 986 End With End With 42VBA 常用技巧代码解析yuanzhuping#040 End Sub代码解析： Mycell 过程在 Excel 工作表中创建自定义的右键快捷菜单。 第 2 行代码，使用 Add 方法添加名称为“Mycell”命令栏，设置“Mycell”命令栏的 Position 属性为 msoBarPopup，使“Mycell”命令栏为快捷菜单。关于 Position 参数的 MsoBarPosition 常数请参阅技巧 11 中的表格 11-1。 第 3 行到第 39 行代码，使用 Add 方法在“Mycell”命令栏中添加菜单和菜单项，并设 置其各项属性。 为了让自定义右键快捷菜单替换 Excel 默认的右键快捷菜单， 并且只在右键单击 Sheet1 工作表时显示，需要在 Sheet1 工作表的 BeforeRightClick 事件中写入下面的代码。#001 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) #002 #003 Application.CommandBars(&Mycell&).ShowPopup Cancel = True#004 End Sub代码解析： 工作表的 BeforeRightClick 事件过程，在右键单击工作表时，将“Mycell”命令栏作为 右键快捷菜单，在当前光标位置显示。 工作表 BeforeRightClick 事件语法如下：Private Sub expression_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)参数 expression 是必需的，Worksheet 类型对象。 参数 Target 是可选的，右键单击发生时最靠近鼠标指针的单元格。 参数 Cancel 是可选的，当事件发生时为 False。如果在事件过程中将 Cancel 参数设为 True，则该过程执行结束之后不进行默认的右键单击操作。 第 2 行代码，使用 ShowPopup 方法将“Mycell”命令栏作为右键快捷菜单，在当前光 标位置显示。 ShowPopup 方法的语法如下：expression.ShowPopup(x, y)参数 expression 是必需的，返回一个 CommandBar 对象。 参数 x 是可选的，快捷菜单所在位置的 x 坐标。如果省略此参数，将使用当前光标位 置的 x 坐标。 参数 y 是可选的，快捷菜单所在位置的 y 坐标。如果省略此参数，将使用当前光标位置 的 y 坐标。43VBA 常用技巧代码解析yuanzhuping当用鼠标右键单击工作表中任意单元格时激活 BeforeRightClick 事件， 此事件先于默认 的右键单击操作。在使用 ShowPopup 方法显示“Mycell”命令栏后，将 Cancel 参数设置 为 True，过程执行结束之后不进行默认的右键单击操作，Excel 右键快捷菜单就不会显示。 运行 Mycell 过程后，右键单击 Sheet1 工作表，在工作表中显示自定义右键快捷菜单， 如图 14-1 所示。图 14-1 自定义右键快捷菜单技巧15 技巧使用右键菜单制作数据有效性在工作表中输入数据时可以使用自定义右键菜单制作数据有效性，如下面的代码所示。#001 Sub Mycell() #002 #003 #004 #005 #006 #007 #008 #009 #010 Dim arr As Variant Dim i As Integer Dim Mycell As CommandBar On Error Resume Next Application.CommandBars(&Mycell&).Delete arr = Array(&经理室&, &办公室&, &生技科&, &财务科&, &营业部&) Set Mycell = Application.CommandBars.Add(&Mycell&, 5) For i = 0 To 4 With Mycell.Controls.Add(1)44VBA 常用技巧代码解析yuanzhuping#011 #012 #013 #014.Caption = arr(i) .OnAction = &MyOnAction& End With Next#015 End Sub #016 Sub MyOnAction() #017 ActiveCell = Application.CommandBars.ActionControl.Caption#018 End Sub代码解析： Mycell 过程创建自定义的右键菜单，请参阅技巧 14 。 MyOnAction 过程是点击自定义右键菜单所运行的过程，将所选右键菜单的名称写入活 动单元格。 为了使自定义的右键菜单在 Sheet1 工作表的特定区域中显示，需要在 VBE 中双击 Sheet1 表后写入下面的代码。#001 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) #002 #003 #004 #005 #006 If Target.Column = 2 Then Call Mycell Application.CommandBars(&Mycell&).ShowPopup Cancel = True End If#007 End Sub代码解析： 工作表的 BeforeRightClick 事件过程，在右键单击工作表时，将“Mycell”命令栏作为 右键快捷菜单，在当前光标位置显示，请参阅技巧 14 。 在工作表的 B 列中点击右键结果如图 15-1 所示。45VBA 常用技巧代码解析yuanzhuping图 15-1 使用右键菜单制作数据有效性技巧16 技巧禁用工作表右键菜单 禁用工作表右键菜单有时并不希望用户使用工作表中的右键菜单对工作表进行操作， 那么可以使用下面的代 码禁用工作表右键菜单。#001 Sub DisBar() #002 #003 #004 #005 #006 #007 Dim myBar As CommandBar For Each myBar In CommandBars If myBar.Type = msoBarTypePopup Then myBar.Enabled = False End If Next#008 End Sub代码解析： DisBar 过程禁用工作表中所有的右键菜单。 第 3 行代码使用 For Each...Next 语句遍历 CommandBars 集合。 CommandBars 集合 代表应用程序中所有的命令栏。 第 4 行代码根据命令栏的 Type 属性判断命令栏是否为右键菜单。 应用于 CommandBar 对象的 Type 属性返回命令栏的类型，可以为表格 16-1 所列的 MsoBarType 常量之一。46VBA 常用技巧代码解析yuanzhuping常量 msoBarTypeMenuBar msoBarTypeNormal msoBarTypePopup值 1 0 2描述 菜单栏 工具栏 右键快捷菜单表格 16-1MsoBarType 常量第 5 行代码将 CommandBars 集合中右键快捷菜的 Enabled 属性设置为 False，使之 无效。 运行 DisBar 过程将禁用工作表中所有的右键菜单，需要恢复时只需将其 Enabled 属性 设置为 True 即可。技巧17 技巧创建自定义工具栏为了方便用户操作，在 Excel 原有的的工具栏上，还可以创建自定义的工具栏，如下面 的代码所示。#001 Sub NowToolbar() #002 #003 #004 #005 #006 #007 #008 报表打印&) #009 #010 #011 #012 #013 #014 id = Array(, , 707, 986) Set Toolbar = Application.CommandBars.Add(&MyToolbar&, msoBarTop) With Toolbar .Protection = msoBarNoResize .Visible = True For i = 0 To 5 47 Dim arr As Variant Dim id As Variant Dim i As Integer Dim Toolbar As CommandBar On Error Resume Next Application.CommandBars(&MyToolbar&).Delete arr = Array(&会计凭证&, &会计账簿&, &会计报表&, &凭证打印&, &账簿打印&, &VBA 常用技巧代码解析yuanzhuping#015 #016 #017 #018 #019 #020 #021 #022 #023With .Controls.Add(Type:=msoControlButton) .Caption = arr(i) .FaceId = id(i) .BeginGroup = True .Style = msoButtonIconAndCaptionBelow End With Next End With Set Toolbar = Nothing#024 End Sub代码解析： NowToolbar 过 程 使 用 Add 方 法 在 Excel 窗 口 中 创 建 自 定 义 工 具 栏 。 应 用 于 CommandBars 对象的 Add 方法请参阅技巧 11 。 第 10 行代码，使用 Add 方法在菜单栏上创建名称为“MyToolbar”的命令栏，创建时 设置新命令栏的 Position 参数为 msoBarTop，使新命令栏位于应用程序窗口的顶部。如果 将 Position 参数设置成 msoBarFloating，新命令栏为浮动工具栏，如图 17-1 所示。图 17-1 浮动命令栏关于 Position 参数的 MsoBarPosition 常数请参阅技巧 11 中的表格 11-1。 第 12 行代码，设置“MyToolbar”命令栏的 Protection 属性为 msoBarNoResize。应 用于 CommandBar 对象的 Protection 属性指定命令栏的保护类型，可以为表格 17-1 所列 的 MsoBarProtection 常数之一。常数 msoBarNoProtection msoBarNoCustomize msoBarNoResize 值 0 1 2 说明 不受保护，可自定义(缺省值) 不能自定义 不能调整大小48VBA 常用技巧代码解析yuanzhupingmsoBarNoMove msoBarNoChangeVisible msoBarNoChangeDock msoBarNoVerticalDock msoBarNoHorizontalDock4 8 16 32 64不能移动 不能更改可见状态 不能改变停靠的位置 不能沿窗口左侧或右侧停放 不能沿窗口顶部或底部停放表格 17-1MsoBarProtection 常数第 14 行到第 21 代码，使用 Add 方法在新命令栏中添加按钮控件，设置按钮控件的各 项属性。 其中第 19 行代码， 设置按钮控件的 Style 属性为 msoButtonIconAndCaptionBelow， 使工具栏按钮显示时包含图标和标题，且标题位于图标之下。 应用于 CommandBar 对象的 Style 属性返回或设置工具栏按钮的显示方式，可以为表 格 17-2 所列的 MsoButtonStyle 常数之一。常数 msoButtonIcon msoButtonCaption ButtonIconandCaption msoButtonIconAndCaptionBelow msoButtonIconAndWrapCaption msoButtonWrapCaption 值 1 2 3 11 7 14 说明 包含图标的按钮 包含标题的按钮 包含图标和标题的按钮 包含图标和标题，且标题位于底部的按钮 包含图标和标题，且标题自动换行的按钮 包含标题，且标题自动换行的按钮表格 17-2MsoButtonStyle 常数运行 NowToolbar 过程，将在 Excel 窗口的顶部创建一个自定义的工具栏，如图 17-2 所示。图 17-2 创建自定义工具栏49VBA 常用技巧代码解析yuanzhuping技巧18 技巧自定义工具栏按钮图标在创建自定义的工具栏时，除了可以为工具栏按钮添加 Excel 内置的图标外，还能为工 具栏按钮添加自定义的图标，如下面的代码所示。#001 Sub AddCustomButton() #002 #003 #004 #005 #006 #007 #008 #009 #010 #011 #012 #013 #014 #015 Dim xBar As CommandBar Dim xButton As CommandBarButton On Error Resume Next Application.CommandBars(&CustomBar&).Delete Set xBar = CommandBars.Add(&CustomBar&, msoBarTop) Set xButton = xBar.Controls.Add(msoControlButton) With xButton .Picture = LoadPicture(ThisWorkbook.Path & &\P.BMP&) .Mask = LoadPicture(ThisWorkbook.Path & &\M.BMP&) .TooltipText = &Excel Home 论坛& End With xBar.Visible = True Set xBar = Nothing Set xButton = Nothing#016 End Sub代码解析： AddCustomButton 过程创建自定义工具栏，并设置工具栏的按钮自定义图标。 第 6、7 行代码，使用 Add 方法在 Excel 窗口中添加自定义工具栏和按钮。请参阅技巧 17 。 第 9 行代码，设置工具栏按钮的 Picture 属性为同一目录中的 p.bmp 图片。 应用于 CommandBarButton 对象的 Picture 属性返回一个 IPictureDisp 对象，表示 CommandBarButton 对象的图像，语法如下：expression.Picture参数是必需的，返回一个 CommandBarButton 对象。 指定对象的 Picture 属性就能设置对象的图像。 第 10 行代码，设置工具栏按钮的 Mask 属性为同一目录中的 m.bmp 图片。 为了使工具栏按钮图标透明显示，在指定对象的 Picture 属性后，还需要指定对象的50VBA 常用技巧代码解析yuanzhupingMask 属性。 应用于 CommandBarButton 对象的 Mask 属性返回表示 CommandBarButton 对象的 屏蔽图像的 IPictureDisp 对象，语法如下：expression.Mask参数是必需的，返回一个 CommandBarButton 对象。 屏蔽图像决定按钮图像透明的部分。 在创建作为屏蔽图像使用的图像时， 所有要透明的 区域应该为白色，所有要显示的区域应该为黑色。 第 11 行代码，设置按钮的“屏幕提示”为“ExcelHome 论坛” 。 运行 AddCustomButton 过程， 创建自定义工具栏， 并设置工具栏按钮的图标， 如图 18-1 所示。图 18-1 自定义工具栏图标技巧19 技巧自定义工作簿图标Excel 标题栏的图标是默认的，而借助 API 函数可以自定义工作簿标题栏图标，如下面 的代码所示。#001 Private Declare Function FindWindow Lib &user32& Alias &FindWindowA& (ByVal lpClassName As String, ByVal lpWindowName As String) As Long #002 Private Declare Function DrawMenuBar Lib &user32& (ByVal hWnd As Long) As Long #003 Private Declare Function SetFocus Lib &user32& (ByVal hWnd As Long) As Long #004 Private Declare Function SendMessage Lib &user32& Alias &SendMessageA& (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long #005 Private Declare Function ExtractIcon Lib &shell32.dll& Alias&ExtractIconA& (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long #006 Private Const WM_SETICON = &H80 51VBA 常用技巧代码解析yuanzhuping#007 Private Sub Workbook_Open() #008 #009 #010 #011 #012 #013 #014 Dim IStyle As Long Dim hIcon As Long Dim hWndForm As Long hWndForm = FindWindow(vbNullString, Application.Caption) hIcon = ExtractIcon(0, ActiveWorkbook.Path & &\p.bmp&, 0) SendMessage hWndForm, WM_SETICON, True, hIcon SendMessage hWndForm, WM_SETICON, False, hIcon#015 End Sub代码解析： 工作簿打开后使用 API 函数自定义工作簿标题栏的图标。 第 1 行到第 6 行代码，API 函数声明。 第 7 行到第 15 行代码，工作簿的 Open 事件过程，把工作簿标题栏默认的图标更改为 同一文件夹下的 p.bmp 图片。 工作簿打开后标题栏如图 19-1 所示，任务栏图标如图 19-2 所示。图 19-1 自定义工作簿标题和图标图 19-2 任务栏图标技巧20 技巧移除工作表的最小最大化和关闭按钮如果不希望工作表的最小、 最大化和关闭按钮出现在菜单栏中， 可以使用以下代码去除：ActiveWorkbook.Protect , , True代码解析： 使用 Protect 方法对工作簿进行保护。 Protect 方法应用于 Workbook 对象的时保护工作 簿使其不至被修改，语法如下：expression.Protect(Password, Structure, Windows) 52VBA 常用技巧代码解析yuanzhuping参数 expression 是必需的，该表达式返回一个 Workbook 对象。 参数 Password 是可选的，为工作表或工作簿指定区分大小写的密码。 参数 Structure 是可选的，如果为 True，则保护工作簿结构（工作表的相对位置） 。默 认值为 False。 参数 Windows 是可选的，如果为 True，则保护工作簿窗口。 恢复工作表的最大、最小化和关闭按钮的代码如下：ActiveWorkbook.Protect , , False在本例中将 Windows 参数设置为 True，使工作簿窗口受到保护，工作表的最小、最大 化和关闭按钮及图标不出现在菜单栏中，如图 20-1 所示。图 20-1 移除工作表最小、最大化和关闭按钮技巧21 技巧在工具栏上添加下拉列表框如果需要在工具栏中添加类似“字体”这样的下拉列表控制框控件，那么可以使用下面 的代码。#001 Sub AddDropdown() #002 #003 #004 #005 #006 #007 #008 #009 #010 #011 #012 #013 Dim myDropdown As Object Dim myCap As Variant Dim i As Integer myCap = Array(&基础应用&, &VBA 程序开发&, &函数与公式&) Call DeleteButton Set myDropdown = Application.CommandBars(&Formatting&).Controls _ .Add(Type:=msoControlDropdown, Before:=1) With myDropdown .Caption = &请选择版块& .OnAction = &myOnA& .Style = msoComboNormal For i = 0 To UBound(myCap) 53VBA 常用技巧代码解析yuanzhuping#014 #015 #016 #017.AddItem myCap(i) Next .ListIndex = 1 End With#018 End Sub #019 Sub DeleteButton() #020 #021 #022 With Application.CommandBars(&Formatting&).Controls(1) If .Caption = &请选择版块& Then .Delete End With#023 End Sub #024 Sub myOnA() #025 #026 #027 #028 #029 Dim myList As Byte myList = Application.CommandBars(&Formatting&) _ .Controls(1).ListIndex ActiveWorkbook.FollowHyperlink _ Address:=&http://club.excelhome.net/forum-& & myList & &-1.html&,NewWindow:=True #030 End Sub代码解析： AddDropdown 过程使用 Add 方法在工具栏中添加下拉列表控制框控件。 第 5 行代码使用 Array 函数创建一个数组用于保存下拉列表控制框控件加载列表项所需 的元素。 第 6 行代码先运行第 19 行到第 23 行的 DeleteButton 过程删除可能存在的下拉列表控 制框控件，以免重复添加。 DeleteButton 过程判断工具栏中第一个控件的 Caption 属性是否 为“请选择版块” ，如果是则删除该下拉列表控制框控件。 第 7 、 8 行 代 码 使 用 Add 方 法 在 工 具 栏 中 添 加 下 拉 列 表 控 制 框 控 件 。 应 用 于 CommandBarControls 对象的 Add 方法请参阅技巧 7 。示例中将其参数 Type 设置为 msoControlDropdown，添加的就是下拉列表控制框控件。 第 10 行代码设置下拉列表控制框控件的 Caption 属性， 应用于 CommandBarControls 对象的 Caption 属性返回或设置指定命令栏控件的题注文字，也可作为默认的“屏幕提示”显 示。 第 11 行代码设置改变下拉列表控制框控件的内容时要运行的过程为第 24 行到第 30 行代码的 myOnA 过程。 myOnA 过程根据下拉列表控制框控件的 ListIndex 属性值打开 Excel54VBA 常用技巧代码解析yuanzhupingHome 论坛中相应的版块。 第 12 行代码设置下拉列表控制框控件的样式。Style 属性返回或设置命令栏控件的显 示方式，该属性值可设置为表格 21-1 所列 MsoComboStyle 常量之一。常量 msoComboLabel msoComboNormal 值 1 0 描述 显示标签 不显示标签表格 21-1MsoComboStyle 常量第 13 行到第 15 行代码使用 AddItem 方法将数组中的元素添加到下拉列表控制框控件 的列表项中。 第 16 行代码将下拉列表控制框控件的 ListIndex 属性设置为 1， 使其显示第一条列表项。 运行 AddDropdown 过程，工具栏如图 21-1 所示。图 21-1 添加下拉列表控制框控件技巧22 技巧屏蔽工作表的复制功能 屏蔽工作表的复制功能 工作表的复制有时我们并不希望用户对工作表中的数据进行复制粘贴操作， 此时可以把所有的复制功 能都屏蔽，如下面的代码所示。#001 #002 Dim CmdCtrls As CommandBarControls Dim Cmd As CommandBarControl#003 Sub ProCopy() #004 #005 #006 #007 #008 #009 Set CmdCtrls = Application.CommandBars.FindControls(ID:=19) For Each Cmd In CmdCtrls Cmd.Enabled = False Next Application.CellDragAndDrop = False Application.OnKey (&^c&), &&55VBA 常用技巧代码解析yuanzhuping#010 End Sub #011 Sub StaCopy() #012 #013 #014 #015 #016 #017 Set CmdCtrls = Application.CommandBars.FindControls(ID:=19) For Each Cmd In CmdCtrls Cmd.Enabled = True Next Application.CellDragAndDrop = True Application.OnKey (&^c&)#018 End Sub代码解析： 第 1、2 行代码在模块顶部声明两个模块级的变量。 第 3 行到第 10 行代码 ProCopy 过程，屏蔽工作表中所有的复制功能。其中第 4 行到 第 7 行代码使用 FindControls 方法将所有与“复制”相关的命令栏控件赋给变量 CmdCtrls 后将其 Enabled 设置为 False。关于 FindControls 方法请参阅技巧 8 。 第 8 行代码屏蔽单元格拖放功能， 关于应用于 Application 对象的 CellDragAndDrop 属 性请参阅错误！未找到引用源。 错误！未找到引用源。 。 错误 第 9 行代码屏蔽&Ctrl+C&组合键功能，关于应用于 Application 对象的 OnKey 方法请 参阅错误！未找到引用源。 错误！未找到引用源。 。 错误 第 11 行到第 18 行代码 StaCopy 过程，恢复所有的复制功能。技巧23 技巧禁用工具栏的自定义在 Excel 中，用户可以通过依次单击菜单“视图”→“工具栏”→“自定义” ，显示“自 定义”选项卡来调整菜单栏和工具栏，如图 23-1、图 23-2 所示。56VBA 常用技巧代码解析yuanzhuping图 23-1 自定义功能图 23-2 自定义选项卡57VBA 常用技巧代码解析yuanzhuping如果不希望用户使用“自定义”选项卡来调整菜单栏和工具栏，可以禁用工具栏的自定 义功能，如下面的代码所示。#001 Sub nCustomize() #002 Application.CommandBars.DisableCustomize = True#003 End Sub代码解析： nCustomize 过程禁用工具栏的自定义功能，应用于 CommandBars 集合对象的 DisableCustomize 属性设置是否禁用工具栏的自定义。如果禁用，返回 True，否则返回 False。 用于启用工具栏的自定义的代码是：#001 Sub yCustomize() #002 Application.CommandBars.DisableCustomize = False#003 End Sub运行 nCustomize 过程，禁用工具栏的自定义对话框，自定义菜单项消失,如图 23-3 所 示。图 23-3 禁用工具栏的自定义58VBA 常用技巧代码解析yuanzhuping技巧24 技巧屏蔽所有的命令栏在使用自定义的操作界面时，需要屏蔽 Excel 中所有的命令栏，可以使用下面的代码。#001 Sub Shielding_1() #002 #003 #004 #005 Dim i As Integer For i = 1 To Application.CommandBars.Count Application.CommandBars(i).Enabled = False Next#006 End Sub代码解析： Shielding_1 过程使用 For...Next 语句遍历 Excel 命令栏，并将其 Enabled 属性设置为 False，使之无效。 还可以使用 For Each...Next 语句遍历所有的 CommandBars 对象，代码如下：#001 Sub Shielding_2() #002 #003 #004 #005 Dim Cmd As CommandBar For Each Cmd In Application.CommandBars Cmd.Enabled = False Next#006 End Sub运行 Shielding_1 或 Shielding_2 过程工作簿如图 24-1 所示。图 24-1 屏蔽所有的命令栏在需要恢复时只需将 Enabled 属性设置为 True 即可，如下面的代码所示。#001 Sub Recovery_1() #002 #003 #004 #005 Dim i As Integer For i = 1 To Application.CommandBars.Count Application.CommandBars(i).Enabled = True Next#006 End Sub #007 Sub Recover_2()59VBA 常用技巧代码解析yuanzhuping#008 #009 #010 #011Dim Cmd As CommandBar For Each Cmd In Application.CommandBars Cmd.Enabled = True Next#012 End Sub代码解析： Recovery_1 和 Recover_2 过程分别使用 For...Next 语句和 For Each...Next 语句遍历 所有的 CommandBars 对象，设置其 Enabled 属性为 True，显示所有的命令栏。技巧25 技巧恢复 Excel 的命令栏如果用户经常添加、删除 Excel 的菜单和工具栏而又没有及时恢复的话，有时会破坏 Excel 默认的用户界面，即使用 Reset 方法也不能恢复成初始状态。 此时可以在电脑的本地硬盘中查找扩展名为*.xlb 的文件，该文件在电脑中的位置会因 Excel 版本的不同而不同，在 XP 操作系统中，该文件位于系统盘的 Documents and Settings\Administrator\Application Data\Microsoft\Excel 文件夹， 其中 Administrator 是电脑 的用户名。找到它最简单的方法是使用 Windows 的搜索功能。按&Win+F&组合键调出 Windows 的搜索窗口，然后用*.xlb 为目标在本地硬盘中进行搜索，如图 25-1 所示。图 25-1 搜索*.xlb 文件如果搜索没有结果，请检查“更多高级选项”中是否选中“搜索隐藏的文件和文件夹”60VBA 常用技巧代码解析yuanzhuping选项，如图 25-2 所示。图 25-2 搜索隐藏的文件和文件夹对 Excel 用户界面的任何修改都会保存在*.xlb 文件中，找到后删除该文件，然后重新 启动 Excel。Excel 会重新创建一个*.xlb 文件，而菜单和工具栏也会全部恢复成初始状态。61VBA 常用技巧代码解析yuanzhuping第3章 控件与用户窗体技巧26 技巧限制文本框的输入用户在使用文本框输入数据时，往往希望能限制输入数据的类型，比如只能输入数字。 但是没有内置的属性能限制在文本框中只能输入数字， 只能在文本框的事件过程中使用代码 来测试输入的是哪类字符，然后只允许输入数字字符和一个“-”号、一个“.”号，如下面 的代码所示。#001 Private Sub TextBox1_KeyPress(ByVal KeyANSI As MSForms.ReturnInteger) #002 #003 #004 #005 #006 #007 #008 #009 #010 #011 #012 #013 #014 #015 Select Case KeyANSI Case Asc(&0&) To Asc(&9&) Case Asc(&-&) If InStr(1, Me.TextBox1.Text, &-&) & 0 Or _ Me.TextBox1.SelStart & 0 Then KeyANSI = 0 End If Case Asc(&.&) If InStr(1, Me.TextBox1.Text, &.&) & 0 Then KeyANSI = 0 End If Case Else KeyANSI = 0 End Select#016 End Sub代码解析： 文本框的 KeyPress 事件过程，测试键盘输入的是哪类字符，只允许输入数字字符和一 个“-”号、一个“.”号。 KeyPress 事件的语法如下：62VBA 常用技巧代码解析yuanzhupingPrivate Sub object_KeyPress( ByVal KeyANSI As MSForms.ReturnInteger)参数 Object 是必需的，一个有效的对象。 参数 KeyANSI 是可选的，整数值，代表标准的数字 ANSI 键代码。 第 2 行代码使用 Case Else 语句测试文本框 KeyPress 事件的 KeyANSI 参数值。 第 3 行代码，如果键盘输入的是 0 到 9 之间的数字字符，则允许输入。如果想在文本 框中允许其它类型的字符输入，在此句代码中列出允许输入的字符即可。 第 4 行到第 8 行代码，如果键盘输入的是“-”号，先使用 InStr 函数测试文本框中是否 已有“-”号，如果 InStr 函数返回值大于 0，说明文本框中已有“