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快乐不是因为拥有的多而是计较的少