VBA 操作excel菜单

VBA 操作excel菜单

 

在thisworkbook中加入：

Option Explicit
Private Sub Workbook_Activate()
    Call myTools
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'Call DelmyTools
End Sub
Private Sub Workbook_Deactivate()
    Call DelmyTools
End Sub
Private Sub Workbook_Open()
    'Call myTools
End Sub

 

在新建模块中加入：

Option Explicit
Sub myTools()
    Dim myTools As CommandBarPopup
    Dim myCap As Variant
    Dim myid As Variant
    Dim i As Byte
    myCap = Array("基础应用", "VBA程序开发", "函数与公式", "图表与图形", "数据透视表")
    myid = Array(281, 283, 285, 287, 292)
    With Application.CommandBars("Worksheet menu bar")
        .Reset
        Set myTools = .Controls("帮助(&H)").Controls.Add(Type:=msoControlPopup, Before:=1)
        With myTools
            .Caption = "Excel Home 技术论坛"
            .BeginGroup = True
            For i = 1 To 5
                With .Controls.Add(Type:=msoControlButton)
                    .Caption = myCap(i - 1)
                    .FaceId = myid(i - 1)
                    .OnAction = "myC"
            End With
            Next
        End With
    End With
    Set myTools = Nothing
End Sub
Public Sub myC()
    MsgBox "您选择了： " & Application.CommandBars.ActionControl.Caption
End Sub
Sub DelmyTools()
    Application.CommandBars("Worksheet menu bar").Reset
End Sub

-------------------------------------------------------------------------

自定义整个菜单：

 

在thisworkbook里加入：

Option Explicit
Private Sub Workbook_Activate()
    Call AddNowBar
End Sub
Private Sub Workbook_Deactivate()
    Call DelNowBar
End Sub

在新建立模块中加入：

Option Explicit
Sub AddNowBar()
    Dim NewBar As CommandBar
    On Error Resume Next
    With Application
        .CommandBars("Standard").Visible = False
        .CommandBars("Formatting").Visible = False
        .CommandBars("Stop Recording").Visible = False
        .CommandBars("toolbar list").Enabled = False
        .CommandBars.DisableAskAQuestionDropdown = True
        .DisplayFormulaBar = False
        .CommandBars("NewBar").Delete
    End With
    Set NewBar = Application.CommandBars.Add(Name:="NewBar", Position:=msoBarTop, MenuBar:=True, Temporary:=True)
    With NewBar
        .Visible = True
        With .Controls.Add(Type:=msoControlPopup)
            .Caption = "系统设置(&X)"
            .BeginGroup = True
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "保存(&S)"
                .BeginGroup = True
                .FaceId = 1975
            End With
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "备份(&B)"
                .BeginGroup = True
                .FaceId = 747
            End With
        End With
        With .Controls.Add(Type:=msoControlPopup)
            .Caption = "会计凭证(&P)"
            .BeginGroup = True
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "录入(&L)"
                .BeginGroup = True
                .FaceId = 197
            End With
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "审核(&S)"
                .BeginGroup = True
                .FaceId = 714
            End With
        End With
        With .Controls.Add(Type:=msoControlPopup)
            .Caption = "会计账簿(&Z)"
            .BeginGroup = True
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "记账(&L)"
                .BeginGroup = True
                .FaceId = 65
            End With
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "结账(&S)"
                .BeginGroup = True
                .FaceId = 47
            End With
        End With
        With .Controls.Add(Type:=msoControlPopup)
            .Caption = "会计报表(&B)"
            .BeginGroup = True
            With .Controls.Add(Type:=msoControlPopup)
                .Caption = "资产负债表(&Y)"
                .BeginGroup = True
                With .Controls.Add(Type:=msoControlButton)
                    .Caption = "月报(&M)"
                    .BeginGroup = True
                    .FaceId = 1180
                End With
                    With .Controls.Add(Type:=msoControlButton)
                        .Caption = "年报(&Y)"
                        .BeginGroup = True
                        .FaceId = 1188
                    End With
                End With
            With .Controls.Add(Type:=msoControlPopup)
                .Caption = "损益表(&S)"
                .BeginGroup = True
                With .Controls.Add(Type:=msoControlButton)
                    .Caption = "月报(&M)"
                    .BeginGroup = True
                    .FaceId = 1180
                End With
                With .Controls.Add(Type:=msoControlButton)
                    .Caption = "年报(&Y)"
                    .BeginGroup = True
                    .FaceId = 1188
                End With
            End With
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "退出系统(&C)"
            .BeginGroup = True
            .Style = msoButtonCaption
        End With
    End With
    Set NewBar = Nothing
End Sub
Sub DelNowBar()
    On Error Resume Next
    With Application
        .CommandBars("Standard").Visible = True
        .CommandBars("Formatting").Visible = True
        .CommandBars("Stop Recording").Visible = True
        .CommandBars("toolbar list").Enabled = True
        .CommandBars.DisableAskAQuestionDropdown = False
        .DisplayFormulaBar = True
        .CommandBars("NewBar").Delete
    End With
End Sub

 

--------------------------------------------------

移除工作表最大化与最小化图标：

可以先定义菜单，然后将功能赋予菜单，一个为禁用，一个为恢复：

 

直接在sheet中加入：

Option Explicit
Private Sub CommandButton1_Click() '移除工作表左上角图标和右上角最小化/最大化/关闭按钮
    ActiveWorkbook.Protect , , True
End Sub

Private Sub CommandButton2_Click() '恢复工作表左上角图标和右上角最小化/最大化/关闭按钮
    ActiveWorkbook.Protect , , False
End Sub

 

---------------------------------------------------

屏蔽工作表的复制功能：

在thisworkbook中加入：

Option Explicit
Private Sub Workbook_Activate()
    Call ProCopy
End Sub
Private Sub Workbook_Deactivate()
    Call StaCopy
End Sub

在新建立模块中加入：

Option Explicit
    Dim CmdCtrls As CommandBarControls
    Dim Cmd As CommandBarControl
Sub ProCopy()
    Set CmdCtrls = Application.CommandBars.FindControls(ID:=19)
    For Each Cmd In CmdCtrls
        Cmd.Enabled = False
    Next
    Application.CellDragAndDrop = False
    Application.OnKey ("^c"), ""
End Sub
Sub StaCopy()
    Set CmdCtrls = Application.CommandBars.FindControls(ID:=19)
    For Each Cmd In CmdCtrls
        Cmd.Enabled = True
    Next
    Application.CellDragAndDrop = True
    Application.OnKey ("^c")
End Sub