ActiveBar控件动态添加子菜单的方法解决思路

Option Explicit

Private Sub ab_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
    Debug.Print Tool.Name
    If Tool.Name = "miFExit" Then Unload Me
End Sub

Private Sub Form_Load()
    CreateTools
    CreateBands
End Sub

Private Sub CreateTools()
Dim Tool As ActiveBar2LibraryCtl.Tool
Dim iCat As Integer
Dim keys(0) As New ShortCut

    iCat = 100
    Set Tool = ab.Tools.Add(iCat + 1, "mnuFile")
    Tool.Caption = "文件(&F)": Tool.SubBand = "mnuFile": Tool.Category = "菜单"
    Set Tool = ab.Tools.Add(iCat + 2, "mnuEdit")
    Tool.Caption = "编辑(&E)": Tool.SubBand = "mnuEdit": Tool.Category = "菜单"
    Set Tool = ab.Tools.Add(iCat + 3, "mnuView")
    Tool.Caption = "视图(&V)": Tool.SubBand = "mnuView": Tool.Category = "菜单"
    Set Tool = ab.Tools.Add(iCat + 4, "mnuHelp")
    Tool.Caption = "帮助(&H)": Tool.SubBand = "mnuHelp": Tool.Category = "菜单"

    iCat = 200
    Set Tool = ab.Tools.Add(iCat + 1, "miFNew")
    Tool.Caption = "新建(&N)...": Tool.Category = "文件"
    keys(0) = "Control+N"
    Tool.SetPicture ddITNormal, LoadPicture(App.Path & "\icons\FileNew.bmp")
    Tool.ShortCuts = keys
    
    Set Tool = ab.Tools.Add(iCat + 2, "miFOpen")
    Tool.Caption = "打开(&O)": Tool.Category = "文件"
'    Tool.SetPicture ddITNormal, LoadPicture(App.Path & "\icons\FileOpen.bmp")
    keys(0) = "Control+O"
    Tool.ShortCuts = keys
    
    Set Tool = ab.Tools.Add(iCat + 3, "miFSave")
    Tool.Caption = "保存(&S)": Tool.Category = "文件"
'    Tool.SetPicture ddITNormal, LoadPicture(App.Path & "\icons\FileSave.bmp")
    keys(0) = "Control+S"
    Tool.ShortCuts = keys

    Set Tool = ab.Tools.Add(iCat + 4, "miFExit")
    Tool.Caption = "退出(&X)": Tool.Category = "文件"
    keys(0) = "Alt+F4"
    Tool.ShortCuts = keys

    iCat = 300
    Set Tool = ab.Tools.Add(iCat + 3, "miECut")
    Tool.Caption = "剪切(&U)": Tool.Category = "编辑"
'    Tool.SetPicture ddITNormal, LoadPicture(App.Path & "\icons\EditCut.bmp")
    keys(0) = "Control+X"
    Tool.ShortCuts = keys
    
    Set Tool = ab.Tools.Add(iCat + 1, "miECopy")
    Tool.Caption = "复制(&C)": Tool.Category = "编辑"
'    Tool.SetPicture ddITNormal, LoadPicture(App.Path & "\icons\EditCopy.bmp")
    keys(0) = "Control+C"
    Tool.ShortCuts = keys
    
    Set Tool = ab.Tools.Add(iCat + 2, "miEPaste")
    Tool.Caption = "打开(&O)": Tool.Category = "编辑"
   ' Tool.SetPicture ddITNormal, LoadPicture(App.Path & "\icons\EditPsate.bmp")
    keys(0) = "Control+V"
    Tool.ShortCuts = keys
    
    iCat = 400
    Set Tool = ab.Tools.Add(iCat + 1, "miVToolbar")
    Tool.Caption = "工具栏(&T)": Tool.Category = "视图"
    
    Set Tool = ab.Tools.Add(iCat + 2, "miVStatusBar")
    Tool.Caption = "状态栏(&S)": Tool.Category = "视图"
    
    iCat = 500
    Set Tool = ab.Tools.Add(iCat + 1, "miHAbout")
    Tool.Caption = "关于(&A)": Tool.Category = "帮助"
    keys(0) = "F1"
    Tool.ShortCuts = keys
End Sub

Private Sub CreateBands()
Dim b As ActiveBar2LibraryCtl.Band

    Set b = ab.Bands.Add("mnuFile"): b.Type = ddBTPopup
    With b.Tools
        .Insert .Count, ab.Tools("miFNew")
        .Insert .Count, ab.Tools("miFOpen")
        .Insert .Count, ab.Tools("miFSave")
        .Insert .Count, ab.Tools("miFExit")
    End With

    Set b = ab.Bands.Add("mnuEdit"): b.Type = ddBTPopup
    With b.Tools
        .Insert .Count, ab.Tools("miECut")
        .Insert .Count, ab.Tools("miECopy")
        .Insert .Count, ab.Tools("miEPaste")
    End With

    Set b = ab.Bands.Add("mnuView"): b.Type = ddBTPopup
    With b.Tools
    .Insert .Count, ab.Tools("miVToolbar")
    .Insert .Count, ab.Tools("miVStatusBar")
    End With

    Set b = ab.Bands.Add("mnuHelp"): b.Type = ddBTPopup
    b.Tools.Insert b.Tools.Count, ab.Tools("miHAbout")
    
    Set b = ab.Bands.Add("mnuMain"): b.Type = ddBTMenuBar
    
    ab.Tools("mnuFile").SubBand = "mnuFile"
    ab.Tools("mnuEdit").SubBand = "mnuEdit"
    ab.Tools("mnuView").SubBand = "mnuView"
    ab.Tools("mnuHelp").SubBand = "mnuHelp"
    
    With b.Tools
        .Insert .Count, ab.Tools("mnuFile")
        .Insert .Count, ab.Tools("mnuEdit")
        .Insert .Count, ab.Tools("mnuView")
        .Insert .Count, ab.Tools("mnuHelp")
    End With
    
    ab.RecalcLayout
    ab.Refresh
End Sub