VBA创建菜单并指定宏代码,该如何处理

fieldset{padding:10px;}

VBA创建菜单并指定宏代码Private Sub auto_open() Call 建立系统工具菜单End SubSub 建立系统工具菜单() 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 WithEnd 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快乐不是因为拥有的多而是计较的少

VBA创建菜单并指定宏代码,该如何处理

相关文章:

你感兴趣的文章:

标签云: