本示例提供了一种管理多个文件的方法——将不同文件中不同表的名字放到菜单上,单击菜单就能调出不同文件中相应的表。
Option Explicit
Sub OpenMenu() '自定义多级选单函数
On Error Resume Next '忽略错误
MenuBars("MyMenu").Delete '删除自定义选单
MenuBars.Add ("MyMenu") '自定义选单项
Sheets("销售部全年记录").Select
'增加第一个选单项“一月份”
MenuBars("MyMenu").Menus.Add Caption:="一月份"
'在“一月份”选单下增加“1月出勤加班统计表”选项
MenuBars("MyMenu").Menus("一月份").MenuItems.Add Caption:="1月出勤加班统计表", OnAction:="SheetOpen11"
'在“一月份”选单下增加“1月销售业绩表”选项
MenuBars("MyMenu").Menus("一月份").MenuItems.Add Caption:="1月销售业绩表", OnAction:="SheetOpen12"
MenuBars("MyMenu").Menus("一月份").MenuItems.Add Caption:="1月销售部工资表", OnAction:="SheetOpen13"
MenuBars("MyMenu").Menus.Add Caption:="二月份" '建立选单项“二月份”
MenuBars("MyMenu").Menus("二月份").MenuItems.Add Caption:="2月出勤加班统计表", OnAction:="sheetopen21"
MenuBars("MyMenu").Menus("二月份").MenuItems.Add Caption:="2月销售业绩表", OnAction:="SheetOpen22"
MenuBars("MyMenu").Menus("二月份").MenuItems.Add Caption:="2月销售部工资表", OnAction:="SheetOpen23"
MenuBars("MyMenu").Activate '激活自定义选单
End Sub
Sub auto_open() '系统自动打开运行宏
OpenMenu '调用用户选单函数
End Sub
Sub auto_close() '系统自动关闭运行宏
On Error Resume Next '忽略错误
MenuBars("MyMenu").Delete '删除自定义的选单
End Sub
Sub SheetOpen11()
Dim book As Workbook '定义一个Workbook变量
On Error Resume Next
Set book = Workbooks("chap16_1.xls")
If book Is Nothing Then '说明chap14_1.xls没打开
'打开chap14_1.xls
Workbooks.Open Filename:=ThisWorkbook.Path + "\chap16_1.xls"
End If
Windows("chap16_1.xls").Activate '使chap14_1为当前文档
'使表"1月出勤加班统计表"为当前活动表
Sheets("1月出勤加班统计表").Activate
End Sub
Sub SheetOpen12()
Dim book As Workbook '定义一个Workbook变量
On Error Resume Next
Set book = Workbooks("chap16_1.xls")
If book Is Nothing Then '说明chap14_1.xls没打开
'打开chap14_1.xls
Workbooks.Open Filename:=ThisWorkbook.Path + "\chap16_1.xls"
End If
Windows("chap16_1.xls").Activate '使chap14_1为当前文档
Sheets("1月销售业绩表").Activate
End Sub
Sub SheetOpen13()
Dim book As Workbook '定义一个Workbook变量
On Error Resume Next
Set book = Workbooks("chap16_1.xls")
If book Is Nothing Then '说明chap14_1.xls没打开
'打开chap14_1.xls
Workbooks.Open Filename:=ThisWorkbook.Path + "\chap16_1.xls"
End If
Windows("chap16_1.xls").Activate '使chap14_1为当前文档
Sheets("1月销售部工资表").Activate
End Sub
Sub SheetOpen21()
Dim book As Workbook '定义一个Workbook变量
On Error Resume Next
Set book = Workbooks("chap16_2.xls")
If book Is Nothing Then '说明chap14_2.xls没打开
'打开chap14_2.xls
Workbooks.Open Filename:=ThisWorkbook.Path + "\chap16_2.xls"
End If
Windows("chap16_2.xls").Activate '使chap14_2为当前文档
Sheets("2月出勤加班统计表").Activate
End Sub
Sub SheetOpen22()
Dim book As Workbook '定义一个Workbook变量
On Error Resume Next
Set book = Workbooks("chap16_2.xls")
If book Is Nothing Then '说明chap14_2.xls没打开
'打开chap14_2.xls
Workbooks.Open Filename:=ThisWorkbook.Path + "\chap16_2.xls"
End If
Windows("chap16_2.xls").Activate '使chap14_2为当前文档
Sheets("2月销售业绩表").Activate
End Sub
Sub SheetOpen23()
Dim book As Workbook '定义一个Workbook变量
On Error Resume Next
Set book = Workbooks("chap16_2.xls")
If book Is Nothing Then '说明chap14_2.xls没打开
'打开chap14_2.xls
Workbooks.Open Filename:=ThisWorkbook.Path + "\chap16_2.xls"
End If
Windows("chap16_2.xls").Activate '使chap14_2为当前文档
Sheets("2月销售部工资表").Activate
End Sub