VBA常用技巧代码解析

yuanzhuping · 发表于 2009-3-17 10:39

技巧79 在菜单中添加菜单项
在Excel工作表的菜单中可以添加新的菜单项和子菜单，如下面的代码所示。

#001 Sub myTools()
#002 Dim myTools As CommandBarPopup
#003 Dim myCap As Variant
#004 Dim myid As Variant
#005 Dim i As Byte
#006 myCap = Array("基础应用", "VBA程序开发", "函数与公式", "图表与图形", "数据透视表")
#007 myid = Array(281, 283, 285, 287, 292)
#008 With Application.CommandBars("Worksheet menu bar")
#009 .Reset
#010 Set myTools = .Controls("帮助(&H)").Controls.Add(Type:=msoControlPopup, Before:=1)
#011 With myTools
#012 .Caption = "Excel Home 技术论坛"
#013 .BeginGroup = True
#014 For i = 1 To 5
#015 With .Controls.Add(Type:=msoControlButton)
#016 .Caption = myCap(i - 1)
#017 .FaceId = myid(i - 1)
#018 .OnAction = "myC"
#019 End With
#020 Next
#021 End With
#022 End With
#023 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是可选的，添加到指定命令栏的控件类型，可以为表格所列的MsoControlType常数之一。

   因为在本例中将添加的是带有子菜单的菜单项，所以将参数Type设置为弹出式控件。
   参数Id是可选的，标识整数。如果将该参数设置为 1或者忽略，将在命令栏中添加一个空的指定类型的自定义控件。
   参数Parameter是可选的，对于内置控件，该参数用于容器应用程序运行命令。对于自定义控件，可以使用该参数向Visual Basic过程传递信息，或用其存储控件信息。
   参数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过程，如下面的代码所示。

#001 Private Sub Workbook_Deactivate()
#002 Call DelmyTools
#003 End Sub

复制代码

如果希望这个菜单为所有工作簿使用，那么就应该在工作簿的Open事件中调用myTools过程，在BeforeClose事件中调用DelmyTools过程。
运行myTools过程，将在Excel工作表菜单栏中的“帮助”菜单中添加一个名为“Excel Home 技术论坛”的菜单项及五个子菜单，如图所示。
未命名.JPG

yuanzhuping · 发表于 2009-3-17 10:57

技巧80 在菜单栏指定位置添加菜单
除了可以在工作表菜单中添加菜单项外，还可以在工作表菜单栏的指定位置添加菜单，如下面的代码所示。

#001 Sub AddNewMenu()
#002 Dim HelpMenu As CommandBarControl
#003 Dim NewMenu As CommandBarPopup
#004 With Application.CommandBars("Worksheet menu bar")
#005 .Reset
#006 Set HelpMenu = .FindControl(ID:=.Controls("帮助(&H)").ID)
#007 If HelpMenu Is Nothing Then
#008 Set NewMenu = .Controls.Add(Type:=msoControlPopup)
#009 Else
#010 Set NewMenu = .Controls.Add(Type:=msoControlPopup, _
#011 Before:=HelpMenu.Index)
#012 End If
#013 With NewMenu
#014 .Caption = "统计(&S)"
#015 With .Controls.Add(Type:=msoControlButton)
#016 .Caption = "输入数据(&D)"
#017 .FaceId = 162
#018 .OnAction = ""
#019 End With
#020 With .Controls.Add(Type:=msoControlButton)
#021 .Caption = "汇总数据(&T)"
#022 .FaceId = 590
#023 .OnAction = ""
#024 End With
#025 End With
#026 End With
#027 Set HelpMenu = Nothing
#028 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。
   参数Recursive是可选的，如果该值为True，那么将在命令栏及其全部弹出式子工具栏中查找。此参数仅应用于CommandBar对象。默认值为False。
   如果没有控件符合搜索条件，那么FindControl方法返回Nothing。
   第7行到第12行代码，如果工作表菜单栏中存在“帮助”菜单，将“统计”菜单添加到“帮助”菜单之前，否则添加到工作表菜单栏末尾。
   第12行到第25行代码，在“统计”菜单中添加两个子菜单并设置其各种属性。
   运行AddNewMenu过程，将在工作表菜单栏的“帮助”菜单之前添加一个“统计”菜单，如图所示。
未命名.JPG

menghuazhang · 发表于 2009-3-17 12:01

如果想要再Sheet1中的A列单元格实现如下功能，如何编写代码？

想要实现的功能：例如，在A1单元格，在插入批注时，批注的内容会按要求的文本显示。比如，“ 序列号：001  002 “

            在对A2单元格插入批注时，批注的内容会自动显示“ 序列号：001  002 “。

            A列所有单元格在进行批注插入时都自动显示完全一样的批注内容“ 序列号：001  002 “。

请教。。。。。。。

oneopen · 发表于 2009-3-17 12:09

感谢楼主，学习的好资料。留名，慢慢学习中……

limy · 发表于 2009-3-17 12:28

谢谢楼主辛勤劳动

yuanzhuping · 发表于 2009-3-17 12:28

原帖由 menghuazhang 于 2009-3-17 12:01 发表
如果想要再Sheet1中的A列单元格实现如下功能，如何编写代码？

想要实现的功能：例如，在A1单元格，在插入批注时，批注的内容会按要求的文本显示。比如，“ 序列号：001 002 “

在对A2单元格插 ...

80楼，14-2 为单元格添加批注，将代码稍做修改即可。

cooldiy · 发表于 2009-3-17 15:16

谢谢啦！！！

yuanzhuping · 发表于 2009-3-17 15:42

技巧81 屏蔽和删除工作表菜单
如果不希望用户使用工作表菜单栏的部分功能，可以把菜单或菜单项屏蔽或删除，如下面的代码所示。

#001 Sub Shibar()
#002 With Application.CommandBars("Worksheet menu bar")
#003 .Reset
#004 .Controls("工具(&T)").Controls("宏(&M)").Enabled = False
#005 .Controls("数据(&D)").Delete
#006 End With
#007 End Sub

复制代码

代码解析：
   Shibar过程屏蔽 “工具”菜单中的“宏”菜单项，删除菜单栏中的“数据”菜单。
   第3行代码，使用Reset方法重置工作表菜单栏。
   第4行代码，将“宏”菜单项的Enabled属性设置为False，使之无效。
   Enabled属性决定命令栏或命令栏控件是否激活，如果将该属性设置为 False，那么该菜单项将无效。
   第5行代码，使用Delete方法将“数据”菜单从工作表菜单栏中删除。
   Delete方法应用于命令栏或命令栏控件时，从集合中删除指定对象，语法如下：
expression.Delete(Temporary)
   参数expression是必需的，返回命令栏或命令栏控件对象之一。
   参数Temporary是可选的，设置为True将从当前会话中删除控件，应用程序在下次会话时将再次显示控件。
   运行Shibar过程，将屏蔽工作表“工具”菜单中的“宏”菜单项和删除工作表菜单栏中的“数据”菜单，如图所示。
未命名.JPG

[ 本帖最后由 yuanzhuping 于 2009-3-17 15:44 编辑 ]

yuanzhuping · 发表于 2009-3-17 15:54

技巧82 改变系统菜单的操作
利用VBA甚至可以改变系统菜单的默认操作，使之达到自定义菜单的效果，如下面的代码所示。

#001 Dim WithEvents Saveas As CommandBarButton
#002 Private Sub Workbook_Open()
#003 Set Saveas = Application.CommandBars("File").Controls("另存为(&A)...")
#004 End Sub
#005 Private Sub Saveas_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
#006 CancelDefault = True
#007 MsgBox "本工作簿禁止另存!"
#008 End Sub

复制代码

代码解析：
   第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，使单击“另存为”菜单时并不执行默认操作而只显示一个消息框。
   将工作簿保存、关闭后，重新打开，单击“另存为”菜单并不执行默认操作，只显示一个消息框，如图所示。

yuanzhuping · 发表于 2009-3-17 17:24

技巧83 定制自己的系统菜单
使用VBA开发的小型应用系统完成后，Excel原有的菜单栏完全可以舍弃不用，只使用自定义的菜单栏，更加方便快捷，如下面的代码所示。

#001 Sub AddNowBar()
#002 Dim NewBar As CommandBar
#003 On Error Resume Next
#004 With Application
#005 .CommandBars("Standard").Visible = False
#006 .CommandBars("Formatting").Visible = False
#007 .CommandBars("Stop Recording").Visible = False
#008 .CommandBars("toolbar list").Enabled = False
#009 .CommandBars.DisableAskAQuestionDropdown = True
#010 .DisplayFormulaBar = False
#011 .CommandBars("NewBar").Delete
#012 End With
#013 Set NewBar = Application.CommandBars.Add(Name:="NewBar", Position:=msoBarTop, MenuBar:=True, Temporary:=True)
#014 With NewBar
#015 .Visible = True
#016 With .Controls.Add(Type:=msoControlPopup)
#017 .Caption = "系统设置(&X)"
#018 .BeginGroup = True
#019 With .Controls.Add(Type:=msoControlButton)
#020 .Caption = "保存(&S)"
#021 .BeginGroup = True
#022 .FaceId = 1975
#023 End With
#024 With .Controls.Add(Type:=msoControlButton)
#025 .Caption = "备份(&B)"
#026 .BeginGroup = True
#027 .FaceId = 747
#028 End With
#029 End With
#030 With .Controls.Add(Type:=msoControlPopup)
#031 .Caption = "会计凭证(&P)"
#032 .BeginGroup = True
#033 With .Controls.Add(Type:=msoControlButton)
#034 .Caption = "录入(&L)"
#035 .BeginGroup = True
#036 .FaceId = 197
#037 End With
#038 With .Controls.Add(Type:=msoControlButton)
#039 .Caption = "审核(&S)"
#040 .BeginGroup = True
#041 .FaceId = 714
#042 End With
#043 End With
#044 With .Controls.Add(Type:=msoControlPopup)
#045 .Caption = "会计账簿(&Z)"
#046 .BeginGroup = True
#047 With .Controls.Add(Type:=msoControlButton)
#048 .Caption = "记账(&L)"
#049 .BeginGroup = True
#050 .FaceId = 65
#051 End With
#052 With .Controls.Add(Type:=msoControlButton)
#053 .Caption = "结账(&S)"
#054 .BeginGroup = True
#055 .FaceId = 47
#056 End With
#057 End With
#058 With .Controls.Add(Type:=msoControlPopup)
#059 .Caption = "会计报表(&B)"
#060 .BeginGroup = True
#061 With .Controls.Add(Type:=msoControlPopup)
#062 .Caption = "资产负债表(&Y)"
#063 .BeginGroup = True
#064 With .Controls.Add(Type:=msoControlButton)
#065 .Caption = "月报(&M)"
#066 .BeginGroup = True
#067 .FaceId = 1180
#068 End With
#069 With .Controls.Add(Type:=msoControlButton)
#070 .Caption = "年报(&Y)"
#071 .BeginGroup = True
#072 .FaceId = 1188
#073 End With
#074 End With
#075 With .Controls.Add(Type:=msoControlPopup)
#076 .Caption = "损益表(&S)"
#077 .BeginGroup = True
#078 With .Controls.Add(Type:=msoControlButton)
#079 .Caption = "月报(&M)"
#080 .BeginGroup = True
#081 .FaceId = 1180
#082 End With
#083 With .Controls.Add(Type:=msoControlButton)
#084 .Caption = "年报(&Y)"
#085 .BeginGroup = True
#086 .FaceId = 1188
#087 End With
#088 End With
#089 End With
#090 With .Controls.Add(Type:=msoControlButton)
#091 .Caption = "退出系统(&C)"
#092 .BeginGroup = True
#093 .Style = msoButtonCaption
#094 End With
#095 End With
#096 Set NewBar = Nothing
#097 End Sub

复制代码

代码解析：
   AddNowBar过程使用Add方法创建自定义菜单栏替换工作表菜单栏。
   第2行代码定义变量NewBar为命令栏。
   第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是可选的，设置新建命令栏的位置或类型，可以为表格所列的 MsoBarPosition常数之一。

   本例中设置“NewBar”命令栏的Position参数为msoBarTop，使“NewBar”命令栏位于Excel窗口的顶部。
   参数MenuBar是可选的，设置为True 将以新命令栏替换活动菜单栏，默认值为False。
   在本例中，设置“NewBar”命令栏的MenuBar属性为True，以“NewBar”命令栏替换活动菜单栏。
   参数Temporary是可选的，设置为True将使新建命令栏为临时命令栏，在关闭应用程序时删除，默认值为False。
   在本例中，设置“NewBar”命令栏的Temporary属性为True，使“NewBar”命令栏为临时命令栏，在关闭应用程序时删除。
   第15行代码，设置“NewBar”命令栏为可见的。
   第16行到95行代码，使用Add方法在“NewBar”命令栏中添加菜单、菜单项及子菜单并设置其各项属性，参阅技巧79 。
   恢复Excel原有的菜单栏的代码如下：

#001 Sub DelNowBar()
#002 On Error Resume Next
#003 With Application
#004 .CommandBars("Standard").Visible = True
#005 .CommandBars("Formatting").Visible = True
#006 .CommandBars("Stop Recording").Visible = True
#007 .CommandBars("toolbar list").Enabled = True
#008 .CommandBars.DisableAskAQuestionDropdown = False
#009 .DisplayFormulaBar = True
#010 .CommandBars("NewBar").Delete
#011 End With
#012 End Sub

复制代码

代码解析：
DelNowBar过程取消 “常用”、“格式”和“停止录制”工具栏的的隐藏，恢复“键入需要帮助的问题”下拉框和编辑栏，删除“NewBar”命令栏。
运行AddNowBar过程，工作表菜单栏如图所示。
未命名.JPG

		自动登录	找回密码
密码			免费注册

VBA常用技巧代码解析

第7部分菜单和工具栏

第7部分菜单和工具栏

袁版您好！弱弱的请教一个问题

版主万岁

第7部分菜单和工具栏

第7部分菜单和工具栏

第7部分菜单和工具栏

VBA常用技巧代码解析

第7部分菜单和工具栏

第7部分 菜单和工具栏

袁版您好！弱弱的请教一个问题

版主万岁

第7部分 菜单和工具栏

第7部分 菜单和工具栏

第7部分 菜单和工具栏

第7部分菜单和工具栏

第7部分菜单和工具栏

第7部分菜单和工具栏

第7部分菜单和工具栏