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