有了前面的功能分析基础，使用VBA代码实现这个功能就不是很难了，逐行读取CommandBarDir.txt里面的信息，然后创建弹出式菜单或者按钮，最终实现的效果如下：
功能实现
01
类模块功能
类模块CCommandBar就是为了响应单击按钮的功能：
- 根据单击的按钮的名称，读取对应名称的txt文件
- 将读取到的文本插入到VBE中
所以，分别先实现2个函数，读取txt文件的内容在前面有过介绍：
- VBA调用外部对象02：FileSystemObject——操作文本文件
- 文件操作——读取
在这里使用FSO来读取。
代码语言：javascript复制Private Function FsoReadTxt(file_name As String) As String
Dim fso As Object, sr As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set sr = fso.OpenTextFile(file_name, 1) 'ForReading=1
FsoReadTxt = sr.ReadAll()
Set fso = Nothing
Set sr = Nothing
End Function在VBE中插入代码，就是操作VBE对象相关的属性和方法
代码语言：javascript复制Private Function InsertCode(str_code As String)
Dim i_row As Long
'获取鼠标定位所在的行号
Application.VBE.ActiveCodePane.GetSelection i_row, 0, 0, 0
'从获取的行号开始处插入代码
Application.VBE.SelectedVBComponent.CodeModule.InsertLines i_row, str_code
End Function这2个函数都放在类模块CCommandBar中。
然后是实现类模块响应按钮的单击事件：
代码语言：javascript复制Public WithEvents cmdbe As VBIDE.CommandBarEvents
Private Sub cmdbe_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
On Error GoTo ErrHandle
Dim str_code As String
Const VBE_DIR As String = "vbaCodes"
str_code = FsoReadTxt(ThisWorkbook.Path & VBE_DIR & CommandBarControl.Caption & ".txt")
InsertCode str_code
Exit Sub
ErrHandle:
MsgBox Err.Description
End SubVBE_DIR的路径名称可以自己设置，但建议放在MyVBA.xlam同一路径下。
02
添加菜单的功能
添加菜单和按钮的代码：
代码语言：javascript复制
'记录所有需要执行单击事件的菜单按钮
Private cbars As Collection
Private Type CommandBarInfo
mso As Long '菜单类型
Caption As String '名称
FaceId As Long '图标
Flag As Long '记录是否是弹出式菜单
End Type
Sub AddCommanBar()
If Not CheckVbproject Then
Exit Sub
End If
Set cbars = New Collection
add_bar
End Sub
Function add_bar() As Long
Dim bar_btn As CommandBarControl
Dim bar_info As CommandBarInfo
Dim num_file As Integer
Dim tmp_bar As CommandBarPopup
Dim my_bar As CommandBarPopup
Dim cbar As CCommandBar
Const sBAR_NAME As String = "插入代码(&C)"
Const VBACodes As String = "vbaCodesCommandBarDir.txt"
On Error Resume Next
Application.VBE.CommandBars(1).Controls(sBAR_NAME).Delete
On Error GoTo 0
'添加菜单
Set my_bar = Application.VBE.CommandBars(1).Controls.Add(msoControlPopup)
my_bar.Caption = sBAR_NAME
Set tmp_bar = my_bar
'打开目录
num_file = VBA.FreeFile
Open ThisWorkbook.Path & VBACodes For Input As #num_file
'跳过标题行
Line Input #num_file, bar_info.Caption
Do Until VBA.EOF(num_file)
Input #num_file, bar_info.mso, bar_info.Caption, bar_info.FaceId, bar_info.Flag
If bar_info.Caption <> "" Then
If bar_info.mso = msoControlPopup Then
'弹出式菜单
Set tmp_bar = my_bar.Controls.Add(msoControlPopup)
tmp_bar.Caption = bar_info.Caption
Else
Set bar_btn = tmp_bar.Controls.Add(bar_info.mso)
bar_btn.Caption = bar_info.Caption
bar_btn.FaceId = bar_info.FaceId
bar_btn.BeginGroup = True
Set cbar = New CCommandBar
Set cbar.cmdbe = Application.VBE.Events.CommandBarEvents(bar_btn)
'添加到集合中
cbars.Add cbar
'flag=1 表示1个popup的结束
If bar_info.Flag = 1 Then Set tmp_bar = my_bar
End If
End If
Loop
Close #num_file
Set bar_btn = Nothing
End Function
Function CheckVbproject() As Boolean
Dim obj As Object
On Error Resume Next
Set obj = Application.VBE.ActiveVBProject
If Err.Number <> 0 Then
MsgBox "请勾选 信任对VBA工程对象模型的访问"
CheckVbproject = False
Else
CheckVbproject = True
End If
End Function因为要操作VBE，所以先使用CheckVbproject检查是否勾选了信任对VBA工程对象模型的访问，如何设置请参考VBA操作VBA——VBA工程对象。
03
自动更新
使用过程中增加了代码后，只要重新打开加载宏就会自动进行更新，在ThisWorkbook模块添加代码：
代码语言：javascript复制Private Sub Workbook_Open()
Call AddCommanBar
End Sub后面需要做的就是维护好CommandBarDir.txt即可。
