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代码来连接我的按钮宏代码，应该怎么做？
[解决办法]
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 With
End Sub
Private Sub 自定义模块()
Dim rag As Range
Set d = CreateObject("Scripting.Dictionary")
Set l = CreateObject("Scripting.Dictionary")
d.RemoveAll
l.RemoveAll
l("") = 0
For 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 If
Next
Dim i1%, i1_%, i2%, j%, a$, b As Double
i1% = 3
i2% = 2
Do
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% + 1
Loop Until i1% > Worksheets("Sheet1").Range("A65536").End(xlUp).Row
End Sub
