在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