VBA常用技巧代码解析

yuanzhuping

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

1. #001  Sub myTools()
   
2. #002      Dim myTools As CommandBarPopup
   
3. #003      Dim myCap As Variant
   
4. #004      Dim myid As Variant
   
5. #005      Dim i As Byte
   
6. #006      myCap = Array("基础应用", "VBA程序开发", "函数与公式", "图表与图形", "数据透视表")
   
7. #007      myid = Array(281, 283, 285, 287, 292)
   
8. #008      With Application.CommandBars("Worksheet menu bar")
   
9. #009          .Reset
   
10. #010          Set myTools = .Controls("帮助(&H)").Controls.Add(Type:=msoControlPopup, Before:=1)
    
11. #011          With myTools
    
12. #012              .Caption = "Excel Home 技术论坛"
    
13. #013              .BeginGroup = True
    
14. #014              For i = 1 To 5
    
15. #015                  With .Controls.Add(Type:=msoControlButton)
    
16. #016                      .Caption = myCap(i - 1)
    
17. #017                      .FaceId = myid(i - 1)
    
18. #018                      .OnAction = "myC"
    
19. #019              End With
    
20. #020              Next
    
21. #021          End With
    
22. #022      End With
    
23. #023      Set myTools = Nothing
    
24. #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的过程名，该过程在用户单击子菜单时运行，本例中设置为下面的过程。

1. #001  Public Sub myC()
   
2. #002      MsgBox "您选择了： " & Application.CommandBars.ActionControl.Caption
   
3. #003  End Sub

复制代码

代码解析：
       myC过程是单击新添加子菜单所运行过程，为了演示方便在这里只使用MsgBox函数显示所其Caption属性。
       删除新添加的菜单项及子菜单的代码如下所示。

1. #001  Sub DelmyTools()
   
2. #002      Application.CommandBars("Worksheet menu bar").Reset
   
3. #003  End Sub

复制代码

代码解析：
       DelmyTools过程使用Reset方法重置菜单栏，删除添加的菜单项及子菜单。
       为了在打开工作簿时自动添加菜单项，需要在工作簿的Activate事件中调用myTools过程，如下面的代码所示。

1. #001  Private Sub Workbook_Activate()
   
2. #002      Call myTools
   
3. #003  End Sub

复制代码

为了在关闭工作簿时删除新添加的菜单项，还需要在工作簿的Deactivate事件中调用DelmyTools过程，如下面的代码所示。

1. #001  Private Sub Workbook_Deactivate()
   
2. #002      Call DelmyTools
   
3. #003  End Sub

复制代码

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

yuanzhuping

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

1. #001  Sub AddNewMenu()
   
2. #002      Dim HelpMenu As CommandBarControl
   
3. #003      Dim NewMenu As CommandBarPopup
   
4. #004      With Application.CommandBars("Worksheet menu bar")
   
5. #005          .Reset
   
6. #006          Set HelpMenu = .FindControl(ID:=.Controls("帮助(&H)").ID)
   
7. #007          If HelpMenu Is Nothing Then
   
8. #008              Set NewMenu = .Controls.Add(Type:=msoControlPopup)
   
9. #009          Else
   
10. #010              Set NewMenu = .Controls.Add(Type:=msoControlPopup, _
    
11. #011                  Before:=HelpMenu.Index)
    
12. #012          End If
    
13. #013          With NewMenu
    
14. #014              .Caption = "统计(&S)"
    
15. #015              With .Controls.Add(Type:=msoControlButton)
    
16. #016                  .Caption = "输入数据(&D)"
    
17. #017                  .FaceId = 162
    
18. #018                  .OnAction = ""
    
19. #019              End With
    
20. #020              With .Controls.Add(Type:=msoControlButton)
    
21. #021                  .Caption = "汇总数据(&T)"
    
22. #022                  .FaceId = 590
    
23. #023                  .OnAction = ""
    
24. #024              End With
    
25. #025          End With
    
26. #026      End With
    
27. #027      Set HelpMenu = Nothing
    
28. #028      Set NewMenu = Nothing
    
29. #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过程，将在工作表菜单栏的“帮助”菜单之前添加一个“统计”菜单，如图所示。

menghuazhang

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

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

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


请教。。。。。。。

oneopen

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

limy

谢谢楼主辛勤劳动

yuanzhuping

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

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

                在对A2单元格插 ...

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

cooldiy

谢谢啦！！！

yuanzhuping

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

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

复制代码

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


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

yuanzhuping

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

1. #001  Dim WithEvents Saveas As CommandBarButton
   
2. #002  Private Sub Workbook_Open()
   
3. #003      Set Saveas = Application.CommandBars("File").Controls("另存为(&A)...")
   
4. #004  End Sub
   
5. #005  Private Sub Saveas_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
   
6. #006      CancelDefault = True
   
7. #007      MsgBox "本工作簿禁止另存!"
   
8. #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

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

1. #001  Sub AddNowBar()
   
2. #002      Dim NewBar As CommandBar
   
3. #003      On Error Resume Next
   
4. #004      With Application
   
5. #005          .CommandBars("Standard").Visible = False
   
6. #006          .CommandBars("Formatting").Visible = False
   
7. #007          .CommandBars("Stop Recording").Visible = False
   
8. #008          .CommandBars("toolbar list").Enabled = False
   
9. #009          .CommandBars.DisableAskAQuestionDropdown = True
   
10. #010          .DisplayFormulaBar = False
    
11. #011          .CommandBars("NewBar").Delete
    
12. #012      End With
    
13. #013      Set NewBar = Application.CommandBars.Add(Name:="NewBar", Position:=msoBarTop, MenuBar:=True, Temporary:=True)
    
14. #014      With NewBar
    
15. #015          .Visible = True
    
16. #016          With .Controls.Add(Type:=msoControlPopup)
    
17. #017              .Caption = "系统设置(&X)"
    
18. #018              .BeginGroup = True
    
19. #019              With .Controls.Add(Type:=msoControlButton)
    
20. #020                  .Caption = "保存(&S)"
    
21. #021                  .BeginGroup = True
    
22. #022                  .FaceId = 1975
    
23. #023              End With
    
24. #024              With .Controls.Add(Type:=msoControlButton)
    
25. #025                  .Caption = "备份(&B)"
    
26. #026                  .BeginGroup = True
    
27. #027                  .FaceId = 747
    
28. #028              End With
    
29. #029          End With
    
30. #030          With .Controls.Add(Type:=msoControlPopup)
    
31. #031              .Caption = "会计凭证(&P)"
    
32. #032              .BeginGroup = True
    
33. #033              With .Controls.Add(Type:=msoControlButton)
    
34. #034                  .Caption = "录入(&L)"
    
35. #035                  .BeginGroup = True
    
36. #036                  .FaceId = 197
    
37. #037              End With
    
38. #038              With .Controls.Add(Type:=msoControlButton)
    
39. #039                  .Caption = "审核(&S)"
    
40. #040                  .BeginGroup = True
    
41. #041                  .FaceId = 714
    
42. #042              End With
    
43. #043          End With
    
44. #044          With .Controls.Add(Type:=msoControlPopup)
    
45. #045              .Caption = "会计账簿(&Z)"
    
46. #046              .BeginGroup = True
    
47. #047              With .Controls.Add(Type:=msoControlButton)
    
48. #048                  .Caption = "记账(&L)"
    
49. #049                  .BeginGroup = True
    
50. #050                  .FaceId = 65
    
51. #051              End With
    
52. #052              With .Controls.Add(Type:=msoControlButton)
    
53. #053                  .Caption = "结账(&S)"
    
54. #054                  .BeginGroup = True
    
55. #055                  .FaceId = 47
    
56. #056              End With
    
57. #057          End With
    
58. #058          With .Controls.Add(Type:=msoControlPopup)
    
59. #059              .Caption = "会计报表(&B)"
    
60. #060              .BeginGroup = True
    
61. #061              With .Controls.Add(Type:=msoControlPopup)
    
62. #062                  .Caption = "资产负债表(&Y)"
    
63. #063                  .BeginGroup = True
    
64. #064                  With .Controls.Add(Type:=msoControlButton)
    
65. #065                      .Caption = "月报(&M)"
    
66. #066                      .BeginGroup = True
    
67. #067                      .FaceId = 1180
    
68. #068                  End With
    
69. #069                      With .Controls.Add(Type:=msoControlButton)
    
70. #070                          .Caption = "年报(&Y)"
    
71. #071                          .BeginGroup = True
    
72. #072                          .FaceId = 1188
    
73. #073                      End With
    
74. #074                  End With
    
75. #075              With .Controls.Add(Type:=msoControlPopup)
    
76. #076                  .Caption = "损益表(&S)"
    
77. #077                  .BeginGroup = True
    
78. #078                  With .Controls.Add(Type:=msoControlButton)
    
79. #079                      .Caption = "月报(&M)"
    
80. #080                      .BeginGroup = True
    
81. #081                      .FaceId = 1180
    
82. #082                  End With
    
83. #083                  With .Controls.Add(Type:=msoControlButton)
    
84. #084                      .Caption = "年报(&Y)"
    
85. #085                      .BeginGroup = True
    
86. #086                      .FaceId = 1188
    
87. #087                  End With
    
88. #088              End With
    
89. #089          End With
    
90. #090          With .Controls.Add(Type:=msoControlButton)
    
91. #091              .Caption = "退出系统(&C)"
    
92. #092              .BeginGroup = True
    
93. #093              .Style = msoButtonCaption
    
94. #094          End With
    
95. #095      End With
    
96. #096      Set NewBar = Nothing
    
97. #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原有的菜单栏的代码如下：

1. #001  Sub DelNowBar()
   
2. #002      On Error Resume Next
   
3. #003      With Application
   
4. #004          .CommandBars("Standard").Visible = True
   
5. #005          .CommandBars("Formatting").Visible = True
   
6. #006          .CommandBars("Stop Recording").Visible = True
   
7. #007          .CommandBars("toolbar list").Enabled = True
   
8. #008          .CommandBars.DisableAskAQuestionDropdown = False
   
9. #009          .DisplayFormulaBar = True
   
10. #010          .CommandBars("NewBar").Delete
    
11. #011      End With
    
12. #012  End Sub

复制代码

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