Excel VBA高效办公应用-第十六章-VBA高效文件操作（使用级联菜单管理多个工作簿）

本示例提供了一种管理多个文件的方法——将不同文件中不同表的名字放到菜单上，单击菜单就能调出不同文件中相应的表。

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