xla创建菜单按钮

要在xla启动的时候添加菜单栏的方法

在thisbook中添加这么一段

Private Sub Workbook_Open()

Call menu

End Sub

menu函数

函数中建立了一条新的工具栏，随后在上面添加了一个下拉栏（msoControlPopup）

下拉之后显示addToolBar，addMenu，AddrightMenu，rightMenuReset，uninstall

━━━━━━━━━━━━━━━━━━━━━━━━━━

Sub menu()

On Error Resume Next

Application.CommandBars("myMnu").Delete

Set myMnu = Application.CommandBars.Add

With myMnu

.Visible = True

.Position = msoBarTop

.Name = "myMnu"

End With

Set subMenu = myMnu.Controls.Add(Type:=msoControlPopup)

subMenu.Caption = "menu1"

Set KJ = subMenu.Controls.Add(Type:=msoControlButton)

With KJ

.Caption = "addToolBar"

.OnAction = "addToolBar"

End With

Set KJ = subMenu.Controls.Add(Type:=msoControlButton)

With KJ

.Caption = "addMenu"

.OnAction = "addMenu"

End With

Set KJ = subMenu.Controls.Add(Type:=msoControlButton)

With KJ

.Caption = "AddrightMenu"

.OnAction = "AddrightMenu"

End With

Set KJ = subMenu.Controls.Add(Type:=msoControlButton)

With KJ

.Caption = "rightMenuReset"

.OnAction = "rightMenuReset"

End With

Set KJ = subMenu.Controls.Add(Type:=msoControlButton)

With KJ

.Caption = "uninstall"

.OnAction = "uninstall"

End With

End Sub

━━━━━━━━━━━━━━━━━━━━━━━━━━

在工具栏【标准】中添加一个感叹号的按钮

faceid : 459是一个感叹号

Caption:是鼠标放上去之后显示的内容

━━━━━━━━━━━━━━━━━━━━━━━━━━

Sub addToolBar()

For Each ct In CommandBars("standard").Controls

If ct.Caption = "myMenu：My Setting Menu" Then

Exit Sub

End If

Next

Set newitem = CommandBars("standard").Controls.Add(Type:=msoControlButton, ID:=1, Before:=19)

With newitem

.Style = msoButtonIcon

.Caption = "myMenu：My Setting Menu"

.OnAction = "showAbout"

.FaceId = 459

End With

End Sub

Sub showAbout()

MsgBox "hello word"

End Sub

━━━━━━━━━━━━━━━━━━━━━━━━━━

在上层菜单栏添加一个下拉按钮，带快捷方式的
显示200个faceid
菜单栏叫做CommandBars("Worksheet Menu Bar")

━━━━━━━━━━━━━━━━━━━━━━━━━━

Sub addMenu()

For Each ct In CommandBars("Worksheet Menu Bar").Controls

If ct.Caption = "My Setting Menu(&A)" Then

Exit Sub

End If

Next

Dim faceid As Integer

Set newMenu = CommandBars("Worksheet Menu Bar").Controls.Add(Type:=msoControlPopup, ID:=1, Before:=8)

With newMenu

.Caption = "My Setting Menu(&A)" & faceid

For faceid = 1 To 200

Set AboutMenu = .Controls.Add(Type:=msoControlButton, ID:=1)

With AboutMenu

.Caption = "My Setting Menu(&A)" & faceid

.Style = msoControlIconAndCaption

.OnAction = "showAbout"

.faceid = faceid

.BeginGroup = True

End With

Next

End With

End Sub
━━━━━━━━━━━━━━━━━━━━━━━━━━
添加右键功能
代码和上面大致一样
右键菜单叫做CommandBars("cell")

━━━━━━━━━━━━━━━━━━━━━━━━━━

Sub AddrightMenu()

Dim foundflag As Boolean

foundflag = False

For Each ct In CommandBars("cell").Controls

If ct.Caption <> "my setting menu(&A)" Then

Else

foundflag = True

End If

Next

If foundflag = False Then

Set newMenu = CommandBars("cell").Controls.Add(Type:=msoControlPopup, ID:=1)

With newMenu

.Caption = "my setting menu(&A)"

.BeginGroup = True

Set nextMenu = .Controls.Add(Type:=msoControlButton, ID:=1)

With nextMenu

.Caption = "my setting menu(&A)"

.Style = msoControlIconAndCaption

.OnAction = "showAbout"

.faceid = 459

End With

End With

End If

End Sub

━━━━━━━━━━━━━━━━━━━━━━━━━━
加载的东西全部卸载
使用reset就行了
Application.CommandBars("cell")
Application.CommandBars("Worksheet Menu Bar")
Application.CommandBars("standard")
Application.CommandBars("cell")

━━━━━━━━━━━━━━━━━━━━━━━━━━

Sub uninstall()

If MsgBox("uninstall？", vbOKCancel + vbQuestion, "提醒：") = vbOK Then

Application.CommandBars("cell").Reset

Application.CommandBars("Worksheet Menu Bar").Reset

Application.CommandBars("standard").Reset

MsgBox "menu create！", vbOKOnly + vbInformation, "提醒："

Else

MsgBox "uninstall cancel", vbOKOnly + vbInformation, "提醒："

End If

End Sub