VBA自定义菜单如何设置快捷键

Static Sub AddMenu() '添加自定义菜单

Dim NewMenuBar As CommandBar

Dim CX As CommandBarControl, JC As CommandBarControl, TB As CommandBarControl, SJ As CommandBarControl, BF As CommandBarControl

Dim DY As CommandBarControl, BZ As CommandBarControl, XX As CommandBarControl, USE As CommandBarControl, WH As CommandBarControl

Dim CW As CommandBarControl, TJ As CommandBarControl, LJC As CommandBarControl, YZ2 As CommandBarControl, YJC As CommandBarControl

Dim LDQ As CommandBarControl, LNB As CommandBarControl, SDQ As CommandBarControl, SNB As CommandBarControl, LAll As CommandBarControl

Dim JSB As CommandBarControl, SAll As CommandBarControl, DDQ As CommandBarControl, DNB As CommandBarControl, CDQ As CommandBarControl

Dim CNB As CommandBarControl, C0 As CommandBarControl, CTZ As CommandBarControl, BF1 As CommandBarControl, BF2 As CommandBarControl

Dim BF8 As CommandBarControl, DY1 As CommandBarControl, DY2 As CommandBarControl, SM As CommandBarControl, FG As CommandBarControl

Dim KK As CommandBarControl, Bh1 As CommandBarControl, Bh2 As CommandBarControl, JB1 As CommandBarControl, JB2 As CommandBarControl

Dim KB As CommandBarControl, FZ As CommandBarControl, SY As CommandBarControl, CZ As CommandBarControl, Z1 As CommandBarControl

Dim Z2 As CommandBarControl, NH As CommandBarControl, B1 As CommandBarControl, B2 As CommandBarControl, B3 As CommandBarControl, BD As CommandBarControl

Dim B5 As CommandBarControl, B6 As CommandBarControl, S1 As CommandBarControl, S2 As CommandBarControl, S3 As CommandBarControl

Dim S5 As CommandBarControl, S6 As CommandBarControl, D1 As CommandBarControl, D2 As CommandBarControl, D3 As CommandBarControl

Dim D5 As CommandBarControl, D6 As CommandBarControl, C1 As CommandBarControl, C2 As CommandBarControl, C3 As CommandBarControl

Dim C5 As CommandBarControl, C6 As CommandBarControl, TJF As CommandBarControl, TL As CommandBarControl, CL As CommandBarControl

Dim ClCells As CommandBarControl, ShHL As CommandBarControl

Application.ScreenUpdating = False

On Error Resume Next

MenuBars(\"MyMenuBar\").Delete

'定义菜单

Set NewMenuBar = CommandBars.Add(MenuBar:=True)

NewMenuBar.Name = \"MyMenuBar\"

NewMenuBar.Visible = True

'定义一级菜单项

Set CX = NewMenuBar.Controls.Add(Type:=msoControlPopup)

CX.Caption = \"程序设置\"

CX.Visible = True

Set JC = NewMenuBar.Controls.Add(Type:=msoControlPopup)

JC.Caption = \"基础数据\"

JC.Visible = True

Set TB = NewMenuBar.Controls.Add(Type:=msoControlPopup)

TB.Caption = \"报表审录\"

TB.Visible = True

Set SJ = NewMenuBar.Controls.Add(Type:=msoControlPopup)

SJ.Caption = \"数据处理\"

SJ.Visible = True

Set BF = NewMenuBar.Controls.Add(Type:=msoControlPopup)

BF.Caption = \"报表备份\"

BF.Visible = True

Set DY = NewMenuBar.Controls.Add(Type:=msoControlPopup)

DY.Caption = \"打印控制\"

DY.Visible = True

Set BZ = NewMenuBar.Controls.Add(Type:=msoControlPopup)

BZ.Caption = \"帮助信息\"

BZ.Visible = True

'定义二级菜单项

Set XX = CX.Controls.Add(Type:=msoControlButton)

With XX

.Caption = \"企业信息\"

.OnAction = \"ShowXX\"

.FaceId = 1016

End With

Set USE = CX.Controls.Add(Type:=msoControlButton)

With USE

.Caption = \"操作设定\"

.OnAction = \"UserSet\"

.FaceId = 1980

End With

Set TIM = CX.Controls.Add(Type:=msoControlButton)

With TIM

.Caption = \"报表时期\"

.OnAction = \"ChangeMonth\"

.BeginGroup = True '菜单选项之间的分隔线

End With

Set WH = CX.Controls.Add(Type:=msoControlPopup)

With WH

.Caption = \"报表维护\"

.BeginGroup = True '菜单选项之间的分隔线

End With

Set CW = JC.Controls.Add(Type:=msoControlPopup)

With CW

.Caption = \"财务报表\"

End With

Set TJ = JC.Controls.Add(Type:=msoControlPopup)

With TJ

.Caption = \"统计数据\"

End With

Set LJC = JC.Controls.Add(Type:=msoControlButton)

With LJC

.Caption = \"基础数据综合录入\"

.BeginGroup = True '菜单选项之间的分隔线

.OnAction = \"ShowJC\"

.FaceId = 353

End With

Set YZ2 = JC.Controls.Add(Type:=msoControlButton)

With YZ2

.Caption = \"增表二数据套用\"

.BeginGroup = True '菜单选项之间的分隔线

.OnAction = \"CountZ1\"

.FaceId = 211

End With

Set YJC = JC.Controls.Add(Type:=msoControlButton)

With YJC

.Caption = \"基础数据导入主表\"

.BeginGroup = True '菜单选项之间的分隔线

.OnAction = \"CountJC\"

.FaceId = 938

End With

Set LDQ = TB.Controls.Add(Type:=msoControlPopup)

With LDQ

.Caption = \"录入定期报表\"

End With

Set LNB = TB.Controls.Add(Type:=msoControlButton)

With LNB

.Caption = \"录入年报报表\"

.OnAction = \"ShowNB\" '无

.FaceId = 162

End With

Set SDQ = TB.Controls.Add(Type:=msoControlPopup)

With SDQ

.Caption = \"定期报表审核\"

.BeginGroup = True '菜单选项之间的分隔线

End With

Set SNB = TB.Controls.Add(Type:=msoControlButton)

With SNB

.Caption = \"年报报表审核\"

.OnAction = \"CheckNB\"

.FaceId = 172

End With

Set JSB = TB.Controls.Add(Type:=msoControlButton)

With JSB

.Caption = \"表间数据计算\"

.OnAction = \"CountBB\"

.FaceId = 283

.BeginGroup = True '菜单选项之间的分隔线

End With

Set LAll = TB.Controls.Add(Type:=msoControlButton)

With LAll

.Caption = \"当期报表通录\"

.BeginGroup = True '菜单选项之间的分隔线

.OnAction = \"ShowBB\"

.FaceId = 212

End With

Set SAll = TB.Controls.Add(Type:=msoControlButton)

With SAll

.Caption = \"当期报表全审\"

.OnAction = \"CheckBB\"

.FaceId = 790

.BeginGroup = True '菜单选项之间的分隔线

End With

Set DDQ = SJ.Controls.Add(Type:=msoControlPopup)

With DDQ

.Caption = \"定期数据导入\"

End With

Set DNB = SJ.Controls.Add(Type:=msoControlButton)

With DNB

.Caption = \"年报数据导入\"

.OnAction = \"InNB\"

.FaceId = 237

End With

Set CDQ = SJ.Controls.Add(Type:=msoControlPopup)

With CDQ

.Caption = \"生成定期数据\"

.BeginGroup = True '菜单选项之间的分隔线

End With

Set CNB = SJ.Controls.Add(Type:=msoControlButton)

With CNB

.Caption = \"生成年报报表数据\"

.FaceId = 762

.OnAction = \"OutNB\"

End With

Set C0 = SJ.Controls.Add(Type:=msoControlButton)

With C0

.Caption = \"生成全部数据\"

.FaceId = 721

.OnAction = \"OutAll\"

.BeginGroup = True '菜单选项之间的分隔线

End With

Set CTZ = SJ.Controls.Add(Type:=msoControlButton)

With CTZ

.Caption = \"生成统计台账\"

.FaceId = 222

.OnAction = \"OutTZ\"

End With

Set BF1 = BF.Controls.Add(Type:=msoControlButton)

With BF1

.Caption = \"备份定期报表\"

.FaceId = 356

.OnAction = \"Copy1\"

End With

Set BF2 = BF.Controls.Add(Type:=msoControlButton)

With BF2

.Caption = \"备份年报套表\"

.FaceId = 1665

.OnAction = \"Copy2\"

End With

Set BF8 = BF.Controls.Add(Type:=msoControlButton)

With BF8

.Caption = \"程序数据表转存\"

.FaceId = 749

.OnAction = \"CopyAll\"

.BeginGroup = True '菜单选项之间的分隔线

If Man = 0 Then

.Enabled = False

End If

End With

Set DY0 = DY.Controls.Add(Type:=msoControlButton)

With DY0

.Caption = \"预览调整\"

.FaceId = 25

.OnAction = \"Print0\"

End With

Set DY1 = DY.Controls.Add(Type:=msoControlButton)

With DY1

.Caption = \"打印当前报表\"

.FaceId = 4

.OnAction = \"Print1\"

End With

Set SM = BZ.Controls.Add(Type:=msoControlButton)

With SM

.Caption = \"程序说明\"

.FaceId = 984

.OnAction = \"Help\"

End With

Set FG = BZ.Controls.Add(Type:=msoControlPopup)

With FG

.Caption = \"统计法规参考\"

.BeginGroup = True '菜单选项之间的分隔线

End With

Set BB = BZ.Controls.Add(Type:=msoControlButton)

With BB

.Caption = \"程序版本信息\"

.OnAction = \"ShowKK\"

.FaceId = 809

.BeginGroup = True '菜单选项之间的分隔线

End With

'定义三级菜单项

Set JB1 = WH.Controls.Add(Type:=msoControlButton)

With JB1

.Caption = \"工作表解锁\"

.FaceId = 916

.OnAction = \"JB1\"

End With

Set Bh1 = WH.Controls.Add(Type:=msoControlButton)

With Bh1

.Caption = \"锁定工作表\"

.FaceId = 4

.OnAction = \"Bh1\"

End With

Set JB2 = WH.Controls.Add(Type:=msoControlButton)

With JB2

.Caption = \"工作簿解锁\"

.FaceId = 719

.OnAction = \"JB2\"

.BeginGroup = True '菜单选项之间的分隔线

If Man = 0 Then

.Enabled = False

End If

End With

Set Bh2 = WH.Controls.Add(Type:=msoControlButton)

With Bh2

.Caption = \"锁定工作簿\"

.FaceId = 718

.OnAction = \"Bh2\"

If Man = 0 Then

.Enabled = False

End If

End With

Set DelCell = WH.Controls.Add(Type:=msoControlButton)

With DelCell

.Caption = \"清除本月表内数据\"

.FaceId = 20

.OnAction = \"Clear1\"

.BeginGroup = True '分隔线

End With

Set ClCells = WH.Controls.Add(Type:=msoControlButton)

With ClCells

.Caption = \"清除本表所有数据\"

.OnAction = \"ClearAll\"

If Man = 0 Then

.Enabled = False

End If

End With

Set SHL = WH.Controls.Add(Type:=msoControlButton)

With SHL

.Caption = \"行列编辑信息\"

.FaceId = 11

.OnAction = \"ShowRC\"

.BeginGroup = True '分隔线

If Man = 0 Then

.Enabled = False

End If

End With

Set KB = WH.Controls.Add(Type:=msoControlButton)

With KB

.Caption = \"查阅所有表\"

.FaceId = 8

.OnAction = \"ShowAll\"

.BeginGroup = True '分隔线

If Man = 0 Then

.Enabled = False

End If

End With

Set FZ = CW.Controls.Add(Type:=msoControlButton)

With FZ

.Caption = \"资产负债表\"

.FaceId = 133

.OnAction = \"ShowFZ\"

End With

Set SY = CW.Controls.Add(Type:=msoControlButton)

With SY

.Caption = \"损益(利润)表\"

.FaceId = 136

.OnAction = \"ShowSY\"

End With

Set CZ = TJ.Controls.Add(Type:=msoControlButton)

With CZ

.Caption = \"总产值计算表\"

.FaceId = 17

.OnAction = \"ShowCZ\"

.BeginGroup = True '分隔线

End With

Set Z1 = TJ.Controls.Add(Type:=msoControlButton)

With Z1

.Caption = \"增加值计算表一\"

.FaceId = 144

.OnAction = \"ShowZ1\"

End With

Set Z2 = TJ.Controls.Add(Type:=msoControlButton)

With Z2

.Caption = \"增加值计算表二\"

.FaceId = 144

.OnAction = \"ShowZ2\"

End With

Set NH = TJ.Controls.Add(Type:=msoControlButton)

With NH

.Caption = \"能耗记录表\"

.FaceId = 107

.OnAction = \"ShowNH\"

End With

Set B1 = LDQ.Controls.Add(Type:=msoControlButton)

With B1

.Caption = \"B201表\"

.FaceId = 483

.OnAction = \"Show201\"

End With

Set B2 = LDQ.Controls.Add(Type:=msoControlButton)

With B2

.Caption = \"B202表\"

.FaceId = 481

.OnAction = \"Show202\"

End With

Set B3 = LDQ.Controls.Add(Type:=msoControlButton)

With B3

.Caption = \"B203表\"

.FaceId = 484

.OnAction = \"Show203\"

.BeginGroup = True '分隔线

End With

Set B5 = LDQ.Controls.Add(Type:=msoControlButton)

With B5

.Caption = \"P205表\"

.FaceId = 482

.OnAction = \"Show205\"

End With

Set B6 = LDQ.Controls.Add(Type:=msoControlButton)

With B6

.Caption = \"P206表\"

.FaceId = 59

.OnAction = \"Show206\"

.BeginGroup = True '分隔线

End With

Set BD = LDQ.Controls.Add(Type:=msoControlButton)

With BD

.Caption = \"乡企定综1表\"

.FaceId = 1763

.OnAction = \"ShowD1\"

.BeginGroup = True '分隔线

End With

Set S1 = SDQ.Controls.Add(Type:=msoControlButton)

With S1

.Caption = \"B201表\"

.FaceId = 329

.OnAction = \"Check201\"

End With

Set S2 = SDQ.Controls.Add(Type:=msoControlButton)

With S2

.Caption = \"B202表\"

.OnAction = \"Check202\"

End With

Set S3 = SDQ.Controls.Add(Type:=msoControlButton)

With S3

.Caption = \"B203表\"

.FaceId = 107

.OnAction = \"Check203\"

.BeginGroup = True '分隔线

End With

Set S5 = SDQ.Controls.Add(Type:=msoControlButton)

With S5

.Caption = \"P205表\"

.OnAction = \"Check205\"

End With

Set S6 = SDQ.Controls.Add(Type:=msoControlButton)

With S6

.Caption = \"P206表\"

.FaceId = 1715

.OnAction = \"Check206\"

.BeginGroup = True '分隔线

End With

Set D1 = DDQ.Controls.Add(Type:=msoControlButton)

With D1

.Caption = \"B201表\"

.FaceId = 239

.OnAction = \"In201\"

.BeginGroup = True '分隔线

End With

Set D2 = DDQ.Controls.Add(Type:=msoControlButton)

With D2

.Caption = \"B202表\"

.OnAction = \"In202\"

.BeginGroup = True '分隔线

End With

Set D3 = DDQ.Controls.Add(Type:=msoControlButton)

With D3

.Caption = \"P203表\"

.FaceId = 317

.OnAction = \"In203\"

.BeginGroup = True '分隔线

End With

Set D5 = DDQ.Controls.Add(Type:=msoControlButton)

With D5

.Caption = \"P205表\"

.OnAction = \"In205\"

End With

Set D6 = DDQ.Controls.Add(Type:=msoControlButton)

With D6

.Caption = \"P206表\"

.FaceId = 271

.OnAction = \"In206\"

.BeginGroup = True '分隔线

End With

Set C1 = CDQ.Controls.Add(Type:=msoControlButton)

With C1

.Caption = \"B201表\"

.FaceId = 538

.OnAction = \"Out201\"

End With

Set C2 = CDQ.Controls.Add(Type:=msoControlButton)

With C2

.Caption = \"B202表\"

.OnAction = \"Out202\"

End With

Set C3 = CDQ.Controls.Add(Type:=msoControlButton)

With C3

.Caption = \"B203表\"

.FaceId = 439

.OnAction = \"Out203\"

.BeginGroup = True '分隔线

End With

Set C5 = CDQ.Controls.Add(Type:=msoControlButton)

With C5

.Caption = \"P205表\"

.OnAction = \"Out205\"

End With

Set C6 = CDQ.Controls.Add(Type:=msoControlButton)

With C6

.Caption = \"P206表\"

.FaceId = 270

.OnAction = \"Out206\"

.BeginGroup = True '分隔线

End With

Set TJF = FG.Controls.Add(Type:=msoControlButton)

With TJF

.Caption = \"统计法\"

.FaceId = 463

.OnAction = \"ShowTJF\"

End With

Set TL = FG.Controls.Add(Type:=msoControlButton)

With TL

.Caption = \"统计管理条例\"

.FaceId = 942

.OnAction = \"ShowTL\"

End With

Set CL = FG.Controls.Add(Type:=msoControlButton)

With CL

.Caption = \"自由裁量权\"

.FaceId = 983

.OnAction = \"ShowCLQ\"

End With

Application.MacroOptions Macro:=\"show201\ShortcutKey:=\"1\"

HasShortcutKey:=True,

Application.ScreenUpdating = True

End Sub