一起学Excel专业开发20：Excel工时报表与分析系统开发（3）——启动与关闭

2019-10-31 22:39:50 浏览数 (1)

对于独立式应用程序，在启动时首先进行版本检查和一些必要的验证，以确保能正确地运行应用程序；然后，保存Excel在应用程序启动前的环境状态，以便在应用程序关闭时恢复Excel原有状态；接下来，创建应用程序用户接口。在关闭时，应用程序删除用户接口并将Excel恢复到该应用程序运行前的原有状态。

全局常量和变量声明

下面是这个应用程序要用到的全局常量和变量：

代码语言：javascript复制
Option Explicit
Option Private Module
 
'标题
Public Const gsAPP_TITLE As String ="PETRAS Reporting"
Public Const gsBACKDROP_TITLE As String ="PETRAS Backdrop"
Public Const gsMENU_BAR As String ="PETRAS Menu Bar"
Public Const gsRESULTS_TEMPLATE As String= "PetrasConsolidation.xltx"
 
'标识自定义文档属性名
Public Const gsPETRAS_TIMESHEET As String= "PetrasTimesheet"
Public Const gsPETRAS_RESULTS As String ="PetrasResults"
 
'注册表设置常量
Public Const gsREG_APP As String = "ProfessionalExcel DevelopmentPETRAS Reporting"
Public Const gsREG_XL_ENV As String ="Excel Settings"
Public Const gsREG_SETTINGS As String ="Settings"
Public Const gsREG_CONSOLIDATION_PATH As String = "ConsolidationPath"
 
'全局伪常量, 例如在开始时设置且未更改的常量
Public gvaKeysToDisable As Variant
Public gbDebugMode As Boolean
 
'全局变量
Public gwbkBackDrop As Workbook  '背景工作簿
Public gwbkResults As Workbook   '当前合并结果工作簿
 
'初始化"常量"全局变量
'它们在应用程序运行时不会变化
Sub InitGlobals()
   gvaKeysToDisable = Array("^{F6}", " ^{F6}","^{TAB}", " ^{TAB}", "%{F11}", "%{F8}","^W", "^{F4}", _
                             "{F11}","%{F1}", " {F11}", " %{F1}", "^{F5}","^{F9}", "^{F10}")
 
    '使用已存在的调试文件来设置是否处于调试模式
   gbDebugMode = Dir(ThisWorkbook.Path & "debug.ini")<> ""
End Sub

代码中的语句：

gvaKeysToDisable =Array("^{F6}", " ^{F6}", "^{TAB}"," ^{TAB}", "%{F11}", "%{F8}", "^W","^{F4}", "{F11}", "%{F1}", " {F11}"," %{F1}", "^{F5}", "^{F9}", "^{F10}")

其括号里的引号部分代表组合键，^代表Ctrl键，%代表Alt键， 代表Shift键，花括号里指出具体的键。

版本和独立性检查

Excel各版本之间还是存在差异的，特别是从97版到2000版、从2003版到2007版，因此，在应用程序运行时必须满足其所要求的最低版本。例如，这里的应用程序要求Excel的最低版本为Excel 2000，故首先应该检查Excel的版本，不允许使用Excel 2000以前版本的用户能够打开应用程序。

代码语言：javascript复制
'检查应用程序是否可以在当前Excel版本中运行
Function CheckOKToStart() As Boolean
 
    'Excel 2000 = 版本 9
   If Val(Application.Version) < 9 Then
       MsgBox "PETRAS报表应用程序需要Excel2000或更高版本.",vbOKOnly, gsAPP_TITLE
       ThisWorkbook.Close False
       Exit Function
   End If
 
    '下面语句可运行,则OK!
   CheckOKToStart = True
End Function

由于Application.Version返回一个字符串值，因此使用Val函数将其转换成数字值。

对于很多应用程序来说，在确定用户的Excel版本满足要求之后，还要检查用户是否安装了应用程序所需要的各种组件，如分析工具包、求解加载宏或者其他的应用程序（如Word）。

1.对于加载宏的检查，可以查看Application.Addins集合，或者检查在Application.LibraryPath返回的路径中是否包含该文件。

2.对于检查是否安装了其他应用程序，可以利用API函数直接查看注册表，或者使用函数CreateObject来创建一个应用程序的进程实例，并判断是否创建成功。

存储和恢复Excel设置

独立式应用程序通常会对Excel用户界面进行大幅修改，以完全控制Excel会话，例如隐藏公式栏、改变很多应用程序设置等，然而Excel会将这些更改视为用户的正常选择并保存，以后会一直沿用下去，除非用户再次修改。因为用户没有办法告诉Excel这些设置是临时的，只供本应用程序使用。

解决这类问题的通用办法是，在应用程序启动时，保存Excel的当前设置，在关闭应用程序时再恢复这些设置。而保存这些设置最方便的地方是加载宏中的工作表，或者是与应用程序相同目录下的纯文本文件，或者是注册表。

启动时在注册表中保存Excel设置

代码语言：javascript复制
'在注册表中存储Excel工作区设置
Sub StoreExcelSettings()
   Dim cbBar As CommandBar
   Dim sBarNames As String
   Dim objTemp As Object
   Dim wkbTemp As Workbook
 
    '一些属性需要打开工作簿,因此创建一个工作簿
   If ActiveWorkbook Is Nothing Then Set wkbTemp = Workbooks.Add
 
    '写入值来表明已存储了设置
   SaveSetting gsREG_APP, gsREG_XL_ENV, "Stored", "Yes"
 
    '在注册表中存储当前Excel设置,
    '用于安全的崩溃恢复
   With Application
       SaveSetting gsREG_APP, gsREG_XL_ENV, "DisplayStatusBar",CStr(.DisplayStatusBar)
       SaveSetting gsREG_APP, gsREG_XL_ENV, "DisplayFormulaBar",CStr(.DisplayFormulaBar)
       SaveSetting gsREG_APP, gsREG_XL_ENV, "Calculation",CStr(.Calculation)
       SaveSetting gsREG_APP, gsREG_XL_ENV, "IgnoreRemoteRequests",CStr(.IgnoreRemoteRequests)
       SaveSetting gsREG_APP, gsREG_XL_ENV, "Iteration",CStr(.Iteration)
       SaveSetting gsREG_APP, gsREG_XL_ENV, "MaxIterations",CStr(.MaxIterations)
 
        '获取可见的命令栏
       For Each cbBar In .CommandBars
            If cbBar.Visible Then sBarNames =sBarNames & "," & cbBar.Name
       Next
       
       SaveSetting gsREG_APP, gsREG_XL_ENV, "VisibleCommandBars",sBarNames
       SaveSetting gsREG_APP, gsREG_XL_ENV, "ShowWindowsInTaskbar",CStr(.ShowWindowsInTaskbar)
 
        '对于Excel 2002及以上版本的特殊项
       If Val(.Version) >= 10 Then
            Set objTemp = .CommandBars
            SaveSetting gsREG_APP,gsREG_XL_ENV, "DisableAskAQuestion",CStr(objTemp.DisableAskAQuestionDropdown)
            SaveSetting gsREG_APP,gsREG_XL_ENV, "AutoRecover", CStr(.AutoRecover.Enabled)
       End If
   End With
 
   If Not wkbTemp Is Nothing Then wkbTemp.Close False
End Sub

关闭时恢复Excel设置

代码语言：javascript复制
'从注册表中读取,恢复Excel工作区设置
Sub RestoreExcelSettings()
   Dim vKey As Variant
   Dim vBarName As Variant
   Dim objTemp As Object
 
    '从注册表中恢复最初的Excel设置
   With Application
        '恢复Excel菜单
       RestoreMenus
 
        '检查要还原的一些设置
       If GetSetting(gsREG_APP, gsREG_XL_ENV, "Stored","No") = "Yes" Then
            .DisplayStatusBar =CBool(GetSetting(gsREG_APP, gsREG_XL_ENV, "DisplayStatusBar", CStr(.DisplayStatusBar)))
            .DisplayFormulaBar =CBool(GetSetting(gsREG_APP, gsREG_XL_ENV, "DisplayFormulaBar",CStr(.DisplayFormulaBar)))
            .IgnoreRemoteRequests =CBool(GetSetting(gsREG_APP, gsREG_XL_ENV, "IgnoreRemoteRequests",CStr(.IgnoreRemoteRequests)))
            .Calculation =CLng(GetSetting(gsREG_APP, gsREG_XL_ENV, "Calculation",CStr(.Calculation)))
            .Iteration =CBool(GetSetting(gsREG_APP, gsREG_XL_ENV, "Iteration",CStr(.Iteration)))
            .MaxIterations = CLng(GetSetting(gsREG_APP,gsREG_XL_ENV, "MaxIterations", CStr(.MaxIterations)))
 
            '显示正确的工具栏
            On Error Resume Next
            For Each vBarName InSplit(GetSetting(gsREG_APP, gsREG_XL_ENV, "VisibleCommandBars"),",")
                Application.CommandBars(vBarName).Visible= True
            Next
            On Error GoTo 0
            .ShowWindowsInTaskbar =CBool(GetSetting(gsREG_APP, gsREG_XL_ENV, "ShowWindowsInTaskbar",CStr(.ShowWindowsInTaskbar)))
 
            '适用于Excel 2002及更高版本的特定内容
            If Val(.Version) >= 10 Then
                Set objTemp = .CommandBars
               objTemp.DisableAskAQuestionDropdown = CBool(GetSetting(gsREG_APP,gsREG_XL_ENV, "DisableAskAQuestion",CStr(objTemp.DisableAskAQuestionDropdown)))
                .AutoRecover.Enabled =CBool(GetSetting(gsREG_APP, gsREG_XL_ENV, "AutoRecover",CStr(.AutoRecover.Enabled)))
            End If
       End If
 
        '重新启用已禁用的快捷键
       If IsArray(gvaKeysToDisable) Then
            For Each vKey In gvaKeysToDisable
                .OnKey vKey
            Next
       End If
   End With
 
    '如果仍然存在,取消背景工作簿保护
   If WorkbookAlive(gwbkBackDrop) Then
       gwbkBackDrop.Unprotect
       gwbkBackDrop.Saved = True
   End If
End Sub

过程中调用的WorkbookAlive函数将在后面相应部分介绍。关于VBA操作注册表的基础知识可参阅《VBA专题07：使用VBA读写Windows注册表》。

其中，Application对象的DisplayStatusBar属性用来获取或设置状态栏，DisplayFormulaBar属性用来获取或设置公式栏，Calculation用来获取计算模式，IgnoreRemoteRequests属性用来获取是否打开单独的Excel实例进程，Iteration属性获取循环引用，MaxIterations属性获取循环引用的最大迭代次数，ShowWindowsInTaskbar属性获取是否在状态栏中显示界面窗口，AutoRecover属性获取自动恢复状态。

该过程中调用RestoreMenus过程来恢复Excel的工具栏：

代码语言：javascript复制
'恢复最初的菜单结构.在独立应用程序中,
'最简单的方法是重新打开xlb文件.
'不能在加载宏中执行这样的操作,
'因为这将破坏在此会话中所创建的任意自定义
Sub RestoreMenus()
    Dim cbCommandBar AsCommandBar
    Dim sPath As String
    Dim sToolbarFile AsString
 
    On Error Resume Next
 
    '重新打开xlsb工具栏自定义文件(如果存在),避免其变大
    sPath =Application.StartupPath
 
    '获取要打开的正确的工具栏文件的名称,
    '取决于Excel版本
    If Val(Application.Version)= 9 Then
        sToolbarFile =Left$(sPath, InStrRev(sPath, "")) & "Excel.xlb"
    ElseIfVal(Application.Version) < 15 Then
        sToolbarFile =Left$(sPath, InStrRev(sPath, "")) & "Excel" &Val(Application.Version) & ".xlb"
    Else
        sToolbarFile =Left$(sPath, InStrRev(sPath, "")) & "Excel15.xlb"
    End If
 
    '如果有,重新打开工具栏文件
    If Dir(sToolbarFile)<> "" Then
        Workbooks.OpensToolbarFile, ReadOnly:=True
    Else
        '如果没有,必须自已整理
 
        '重新启用所有工具栏(包括Excel标准菜单)
        For Each cbCommandBarIn Application.CommandBars
           cbCommandBar.Enabled = True
        Next
 
        '删除自定义菜单栏
       Application.CommandBars(gsMENU_BAR).Delete
    End If
End Sub

工具栏的定制信息存储在一个扩展名为“xlb”的文件中，其文件名随Excel版本的不同而不同（参见《Excel揭秘20：xlb文件》）。每当对工具栏进行修改，相关的修改信息就会存储在这个文件中。由于独立式应用程序常常要对工具栏进行大量的修改，这会导致xlb文件的容量迅速膨胀。当xlb文件过大后，会导致Excel启动过程变慢，最终使启动过程崩溃。为避免发生这种情况，恢复工具栏配置信息最好的方法是在应用程序关闭之前查找并打开xlb文件，这样，Excel就不会觉察到任何变化，也就不会对xlb文件进行任何修改。（注：Excel 2007及以后的版本已发生变化，我们以后再谈。）

配置Excel环境

在获取了Excel在启动应用程序前的用户环境设置后，可以对Excel进行配置来满足应用程序的需要，包括：

1.设置应用程序的标题和图标。

2.根据需要隐藏公式栏和状态栏。

3.设置计算方式为手动（由应用程序控制重新计算）。

4.设置Application.IgnoreRemoteRequests=True，这样在双击Excel工作簿图标时会打开一个新的Excel进程实例，而不会重用原来的进程实例。

5.关闭任务栏中的窗口。因为可能会处理多个打开的工作簿，此时不允许用户在这些工作簿之间进行跳转。

6.不允许定制命令栏。

7.针对Excel 2002及其以后的版本关闭自动恢复功能。

代码如下：

代码语言：javascript复制
'为应用程序配置Excel工作区
Sub ConfigureExcelEnvironment()
   Dim objTemp As Object
   Dim vKey As Variant
 
   With Application
        '设置所需的应用程序属性
       .Caption = gsAPP_TITLE
       .DisplayStatusBar = True
       .DisplayFormulaBar = False
       .Calculation = xlManual
 
       .DisplayAlerts = False
       .IgnoreRemoteRequests = True
       .DisplayAlerts = True
 
       .Iteration = True
       .MaxIterations = 100
 
        '对于Excel 2000及以上版本的特定项
       If Val(.Version) >= 9 Then
            .ShowWindowsInTaskbar = False
       End If
 
        '对于Excel 2002及以上版本的特定项
       If Val(.Version) >= 10 Then
            Set objTemp = .CommandBars
            objTemp.DisableAskAQuestionDropdown= True
            objTemp.DisableCustomize = True
            .AutoRecover.Enabled = False
       End If
 
        '根据是否要调试,具有稍微不同的环境状态
       If gbDebugMode Then
            '由于对环境的要求很高，因此应该设置一个热键组合来还原
            '键组合是Shift Ctrl R
            .OnKey " ^R","RestoreExcelSettings"
       Else
            '确保VBE不可见
            .VBE.MainWindow.Visible = False
 
            '禁用快捷键
            For Each vKey In gvaKeysToDisable
                .OnKey vKey, ""
            Next
       End If
   End With
End Sub

在开发和调试独立式应用程序时，通常要能够访问VBE和各种隐藏的表格，以及在Excel界面和应用程序界面之间方便地进行切换。当然，最终用户不能进行相同的操作。

实现上述目标的一个最简单的方法是在应用程序启动过程中，检查在指定位置是否存在某个特定的文件，并相应设置一个逻辑变量gbDebugMode。如果逻辑变量的值为True（也就是上述指定文件存在），则可以设置方便地设置调试模式与产品模式。

针对调试模式和产品模式可以分别设置不同的Excel运行环境。在调试模式中，所有Excel快捷键都可用。在产品模式中，禁用所有的Excel快捷键并确保VBE为隐藏状态。

独立式应用程序对Excel环境的设置的典型代码如上面的ConfigureExcelEnvironment过程。

javascript vba 编程算法

0 人点赞