VBA创建菜单并指定宏代码
Private Sub auto_open()
Call 建立系统工具菜单
End Sub
Sub 建立系统工具菜单()
Dim cmdBar As CommandBar
Dim cmdMenu As CommandBarPopup
Dim cmdBtn As CommandBarButton
Set cmdBar = Application.CommandBars("WorkSheet Menu Bar")
'Set cmdBar = Application.CommandBars(1)
With cmdBar
Set cmdMenu = .Controls.Add(Type:=msoControlPopup, before:=4, temporary:=True)
With cmdMenu
.Caption = "工具箱(&K)"
With .Controls.Add(Type:=msoControlButton)
.Caption = "神奇按钮(&K)"
.OnAction = "神奇按钮"
.FaceId = 185
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "显示所有工作表(D)"
.OnAction = "显示所有工作表"
.FaceId = 12
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "卸载软件(&U)"
.OnAction = "卸载"
.FaceId = 12
End With
End With
End With
End Sub
以上是excel自动建立菜单的代码，但是现在我想指定我的宏代码，也就是说点击菜单的时候可以运行我的宏代码；因为我目前的代码是通过按钮来执行的，现在我想用上面的VBA代码来连接我的按钮宏代码，应该怎么做？
[解决办法]
- VB code
Sub auto_open() Dim cmdBar As CommandBar Dim cmdMenu As CommandBarPopup Dim cmdBtn As CommandBarButton Set cmdBar = Application.CommandBars("WorkSheet Menu Bar") With cmdBar Set cmdMenu = .Controls.Add(Type:=msoControlPopup, before:=4, temporary:=True) With cmdMenu .Caption = "工具箱(&K)" With .Controls.Add(Type:=msoControlButton) .Caption = "运行自定义模块(&K)" .OnAction = "自定义模块" .FaceId = 185 End With End With End WithEnd SubPrivate Sub 自定义模块()Dim rag As RangeSet d = CreateObject("Scripting.Dictionary")Set l = CreateObject("Scripting.Dictionary")d.RemoveAlll.RemoveAlll("") = 0For Each rag In Worksheets("Sheet1").Range("O2:BK2") If rag.End(xlDown).Row >= 65536 Then l(rag.Value) = 0 Else l(rag.Value) = rag.End(xlDown).Value End IfNextDim i1%, i1_%, i2%, j%, a$, b As Doublei1% = 3i2% = 2Do If Trim(Worksheets("Sheet1").Range("B" & i1%).Value) <> "" And Worksheets("Sheet1").Range("D" & i1%).Value <> "" Then If d.exists(Worksheets("Sheet1").Range("B" & i1%).Value) Then Worksheets("Sheet2").Range("J" & d(Worksheets("Sheet1").Range("B" & i1%).Value)).Value = Worksheets("Sheet1").Range("A" & i1%).Value Worksheets("Sheet2").Range("K" & d(Worksheets("Sheet1").Range("B" & i1%).Value)).Value = Worksheets("Sheet1").Range("K" & i1%).Value i1_% = i1% + 1 Do If Worksheets("Sheet1").Range("A" & i1%).Value = Worksheets("Sheet1").Range("A" & i1_%).Value And _ Left(Worksheets("Sheet1").Range("C" & i1_%).Value, 1) = "T" Then Worksheets("Sheet2").Range("L" & d(Worksheets("Sheet1").Range("B" & i1%).Value)).Value = Worksheets("Sheet1").Range("D" & i1_%).Value Exit Do End If i1_% = i1_% + 1 Loop Until Worksheets("Sheet1").Range("A" & i1%).Value <> Worksheets("Sheet1").Range("A" & i1_%).Value Else d(Worksheets("Sheet1").Range("B" & i1%).Value) = i2% Worksheets("Sheet2").Range("A" & i2%).Value = Worksheets("Sheet1").Range("B" & i1%).Value Worksheets("Sheet2").Range("B" & i2%).Value = Worksheets("Sheet1").Range("C" & i1%).Value Worksheets("Sheet2").Range("C" & i2%).Value = Worksheets("Sheet1").Range("A" & i1%).Value Worksheets("Sheet2").Range("D" & i2%).Value = Worksheets("Sheet1").Range("K" & i1%).Value i1_% = i1% + 1 Do If Worksheets("Sheet1").Range("A" & i1%).Value = Worksheets("Sheet1").Range("A" & i1_%).Value And _ Left(Worksheets("Sheet1").Range("C" & i1_%).Value, 1) = "T" Then Worksheets("Sheet2").Range("E" & i2%).Value = Worksheets("Sheet1").Range("D" & i1_%).Value Exit Do End If i1_% = i1_% + 1 Loop Until Worksheets("Sheet1").Range("A" & i1%).Value <> Worksheets("Sheet1").Range("A" & i1_%).Value a$ = Worksheets("Sheet1").Range("H" & i1%).Value b = 0 Do If InStr(a$, "+") > 0 Then b = b + l(Left(a$, InStr(a$, "+") - 1)) a$ = Replace(a$, Left(a$, InStr(a$, "+")), "") Else b = b + l(a$) Exit Do End If Loop Worksheets("Sheet2").Range("F" & i2%).Value = b Worksheets("Sheet2").Range("G" & i2%).Value = Worksheets("Sheet1").Range("D" & i1%).Value Worksheets("Sheet2").Range("H" & i2%).Value = Worksheets("Sheet1").Range("E" & i1%).Value Worksheets("Sheet2").Range("I" & i2%).Value = Worksheets("Sheet1").Range("J" & i1%).Value i2% = i2% + 1 End If End If i1% = i1% + 1Loop Until i1% > Worksheets("Sheet1").Range("A65536").End(xlUp).RowEnd Sub