xla创建菜单按钮

最新推荐文章于 2020-12-06 14:32:48 发布

linsiyong1

最新推荐文章于 2020-12-06 14:32:48 发布

阅读量772

点赞数

分类专栏： excel

本文链接：https://blog.csdn.net/linsiyong1/article/details/8107142

版权

excel 专栏收录该内容

1 篇文章 0 订阅

订阅专栏

要在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