方法value作用于对象range时失败_一起学Excel专业开发16：使用表驱动的方法管理工作表用户接口...

学习Excel技术，关注微信公众号：

excelperfect

在工作表中存储需要完成的任务，代码从工作表中读取这些任务并执行，从而完成相应的操作，这就是表驱动方法。

通常，表驱动的方法能够：

1.管理工作簿和工作表用户接口的设置。在程序运行时会进行许多设置，但在开发过程中这些设置会影响开发工作的顺利进行，通过表驱表的方法来定义、应用和删除这些设置。

2.构建命令栏界面。

3.保存和恢复工作表用户界面。

4.创建用户窗体。

典型的工作表用户接口设置：

1.行列的隐藏。隐藏行列是一种非常有用的接口构建技术，但在开发或维护应用程序时，不希望行列处于隐藏状态。

2.保护。对工作簿和工作表进行保护，可以有效防止用户更改接口中不能修改的部分。

3.滚动区。对用户接口工作表设置滚动区，可以有效防止用户游离到工作区之外。

4.设置可用性。与滚动区协同工作，将输入焦点限制在用户接口中，避免用户选择用户接口区域外的单元格。

5.行列标题。在开发过程中行列标题处于可见状态，在运行过程中处于隐藏状态。

6.工作表的可见性。在大多数用户接口中，常需要一个或多个用于完成后台任务的工作表。在开发或维护时这些工作表可见，但在运行时应为不可见和不能修改的状态。

用于接口设置的工作表

下面主要介绍表驱动方法是如何创建和维护用户接口设置的。如下图1所示是一个用于接口设置的工作表。

图1

1.该工作表的第一列存储表示用户接口工作表的名称，注意，这里是工作表的代码名称(即在VBE工程资源管理器中设置的用于标识工作表的名称)而不是工作表标签名称(即工作表界面底部标签名)。并将该列命名为动态名称区域，名称为tblSheetNames，命名公式为：

=OFFSET(wksUISettings!$A$1,1,0,COUNTA(wksUISettings!$A:$A)-1,1)

2.该工作表的第一行存储用于用户接口工作表各项设置的名称，这些名称都是在用户接口工作表中预先定义好了的。并将该行命名为动态名称区域，名称为：tblRangeNames，命名公式为：

=OFFSET(wksUISettings!$A$1,0,1,1,COUNTA(wksUISettings!$1:$1)-1)

3.该工作表中行列交叉处的值即为对用户接口工作表中相应设置项的值。例如列B与第二行交叉处的值“1”，表示设置工作表wksTimeEntry中的程序行数为1。

这个工作表通常位于加载宏的工作表中，而管理工作表中设置值的VBA代码存放在加载宏的工具模块中。(工具模块其实就是一个标准模块，用于在开发过程中辅助程序员的工作，但并不被应用程序本身使用。)

用于接口设置的工作表的工具代码

工具代码完成下面两项任务：

1.读取用于接口设置的工作表，为接口工作簿中的每个工作表添加相应的预定义名称。

2.遍历接口工作簿中的每个工作表，按照用于接口设置的工作表中的顺序读取相应预定义名称的值，并将其保存到用于接口设置的工作表中相应的单元格中。

3.删除接口工作表中的所有设置，便于工作簿维护和修改。

代码1：定义常量

'定义代表接口工作簿及工作表名和预定义名称名的常量Private Const msFILE_TIME_ENTRY As String= "PetrasTemplate.xlsx"Private Const msRNG_NAME_LIST As String ="tblRangeNames"Private Const msRNG_SHEET_LIST As String= "tblSheetNames"

代码2：将设置值写入接口工作簿工作表

'将用于接口设置的工作表中指定的设置值'写入接口工作簿工作表中Public Sub WriteSettings()    '变量声明    Dim rngSheet As Range   Dim rngSheetList As Range   Dim rngName As Range   Dim rngNameList As Range   Dim rngSetting As Range   Dim sSheetTab As String   Dim wkbBook As Workbook   Dim wksSheet As Worksheet       '关闭屏幕更新和自动计算    '提高代码处理速度   Application.ScreenUpdating = False   Application.Calculation = xlCalculationManual       '工时输入工作簿   Set wkbBook = Application.Workbooks(msFILE_TIME_ENTRY)    '设置值所在工作表的第一列   Set rngSheetList = wksUISettings.Range(msRNG_SHEET_LIST)    '设置值所在工作表的第一行(预定义的名称)   Set rngNameList = wksUISettings.Range(msRNG_NAME_LIST)       '遍历设置值所在工作表第一列所指的所有工作表   For Each rngSheet In rngSheetList        'sSheetTabName()函数将工作表代码名称        '转换为相应的标签名称       sSheetTab = sSheetTabName(wkbBook, rngSheet.Value)       Set wksSheet = wkbBook.Worksheets(sSheetTab)               '将设置值应用到当前工作表        '如果设置值已存在则覆盖原设置值       For Each rngName In rngNameList            '设置值在工作表名所在行和预定义名所在列交叉单元格中           Set rngSetting =Intersect(rngSheet.EntireRow, _                                       rngName.EntireColumn)                           '忽略值为空的预定义名称            If Len(rngSetting.Value) > 0Then                wksSheet.Names.AddrngName.Value, _                            "=" &rngSetting.Value            End If       Next rngName   Next rngSheet       '恢复屏幕更新和自动计算   Application.ScreenUpdating = True   Application.Calculation = xlCalculationAutomaticEnd Sub

注意，代码并没有将驱动表中的任何设置应用到接口工作簿中，只是在接口工作簿中定义了名称来记录需要应用的各种设置。

上述代码图片版如下：

代码3：将工作表代码名称转换成工作表标签名的自定义函数

Private Function sSheetTabName(ByRefwkbProject As Workbook, _            ByRef sCodeName As String) AsString   Dim wksSheet As Worksheet   For Each wksSheet In wkbProject.Worksheets       If wksSheet.CodeName = sCodeName Then            sSheetTabName = wksSheet.Name            Exit For       End If   Next wksSheetEnd Function

上述代码图片版如下：

代码4：读取接口工作簿中预定义名称的值到用于接口设置的工作表中

'从接口工作簿中读取预定义名称设置值到'用于接口设置的工作表相应单元格中Public Sub ReadSettings()    '声明变量   Dim lOffset As Long   Dim rngName As Range   Dim rngNameList As Range   Dim rngSetting As Range   Dim sMsg As String   Dim vSetting As Variant   Dim uAnswer As VbMsgBoxResult   Dim wkbBook As Workbook   Dim wksSheet As Worksheet       '下面的操作不可逆    '在清除工作表内容前提醒用户   uAnswer = vbNo   sMsg = "你想使用当前模板设置覆盖现有数据吗?"   uAnswer = MsgBox(sMsg, vbQuestion + vbYesNo)      If uAnswer = vbYes Then        '关屏屏幕更新和自动计算       Application.ScreenUpdating = False       Application.Calculation = xlCalculationManual               '工时输入工作簿       Set wkbBook = Application.Workbooks(msFILE_TIME_ENTRY)               '清除自第2行起工作表已有内容       wksUISettings.UsedRange.Offset(1, 0).Clear           '赋值预定义名称区域       wkbBook.Activate       Set rngNameList = wksUISettings.Range(msRNG_NAME_LIST)               '遍历接口工作簿工作表       For Each wksSheet In wkbBook.Worksheets            lOffset = lOffset + 1                       '将预定义名称值写入用于接口设置的工作表单元格            With wksUISettings.Range("A1").Offset(lOffset, 0)                '工作表代码名称               .Value =wksSheet.CodeName                '遍历预定义名称                For Each rngName In rngNameList                    '获取要写入的单元格                    Set rngSetting =Intersect(.EntireRow, _                                       rngName.EntireColumn)                                      'setScrollArea设置需要专门处理                    '因为它是命名区域而不是命名常量                    If rngName.Value ="setScrollArea" Then                        '这项设置可能不存在因此这里有错误处理                       'On Error Resume Next.                        On Error Resume Next                        rngSetting.Value = _                       wksSheet.Range("setScrollArea").Address                        On Error GoTo 0                    Else                        vSetting = Empty                        vSetting =Application.Evaluate( _                            "'" &wksSheet.Name & "'!" & _                            rngName.Value)                        If NotIsError(vSetting) Then                            rngSetting.Value =vSetting                        End If                    End If                Next rngName            End With       Next wksSheet           '恢复屏幕更新和自动计算       ThisWorkbook.Activate       Application.ScreenUpdating = True       Application.Calculation = xlCalculationAutomatic   End IfEnd Sub

为什么还要将接口工作簿中的设置写回到用于接口设置的工作表中呢？因为直接在接口工作簿中采取手工方式更新设置非常容易，只需要更新每个工作表的预定义名称值即可。在完成这些调整操作后，将最新的预定义名称值写回到用于接口设置的工作表中，以保持驱动表与接口工作簿设置一致。

上述代码图片版如下：

代码5：删除设置

'删除接口工作簿中的所有设置'以便对工作簿进行维护Public Sub RemoveSettings()    '声明变量   Dim wkbBook As Workbook   Dim wksSheet As Worksheet       '关闭屏幕更新和自动计算    '加快代码的执行速度   Application.ScreenUpdating = False   Application.Calculation = xlCalculationManual       '工时输入工作簿   Set wkbBook = Application.Workbooks(msFILE_TIME_ENTRY)       '遍历工作簿中的工作表    '删除设置   For Each wksSheet In wkbBook.Worksheets       wksSheet.Unprotect       wksSheet.Visible = xlSheetVisible       wksSheet.Activate       Application.ActiveWindow.DisplayHeadings = True       wksSheet.EnableSelection = xlNoRestrictions       wksSheet.ScrollArea = ""        With wksSheet.UsedRange            .EntireColumn.Hidden = False            .EntireRow.Hidden = False       End With   Next wksSheet     '恢复屏幕更新和自动计算   Application.ScreenUpdating = True   Application.Calculation = xlCalculationAutomaticEnd Sub

上述代码图片版如下：

有兴趣的朋友可以在完美Excel公众号底部发送消息：

工时表加载宏

下载示例对照研究。