65.9K
CodeProject 正在变化。 阅读更多。
Home

Excel 增强的资源字符串生成器实战:你必须吃自己的狗粮,并且喜欢它!

starIconstarIconstarIconstarIcon
emptyStarIcon
starIcon

4.92/5 (14投票s)

2016年6月25日

BSD

30分钟阅读

viewsIcon

25091

downloadIcon

247

基于Excel的资源生成器,版本2,得到了极大的改进,文档也更完善。

引言

今天我被提醒了,为什么开发人员要么使用自己的创作(吃自己的狗粮),要么与这样做过的专业测试人员密切合作至关重要。如果开发人员独立工作,很容易忽略一些重要的细节,使得他们的创作比应该的更难使用,甚至完全有缺陷。到了项目结束时,我得到了一个非常有说服力的提醒,即要预见到可能破坏看似最简单的任务的所有因素需要多少工作,以及有多少步骤在不经思考的情况下就被完成了。

背景

大约一年前(根据VBA模块中的修订历史,是2015年3月),我创建了Win32_ResGen.XLSM,这是一个启用宏的Microsoft Excel 2010工作簿,用于组织字符串、定义Win32字符串资源,并将它们转换为资源编译器脚本。虽然此后我使用过它几次,但最后一次使用是在几个月前。此外,该应用程序在三个关键方面与促使其创建的任务不同。

  1. 当前的任务是通过一个只读字符串表资源,将一组我定义为常规预处理器宏的字符串字面量移动到标准的Windows资源脚本中。
  2. 要合并资源的项目既没有字符串表,也没有资源脚本。
  3. 由于我将项目从Visual Studio 6升级到了Visual Studio 2013,资源脚本将由Visual Studio 2013资源编辑器从头开始生成。

这些情况的结合使我注意到,在该“防碰撞共享字符串资源”中,它扮演着重要的支持角色,其中对工作簿的解释存在一些缺陷,并且资源脚本解析器的实现存在不足,导致它无法与Microsoft资源编辑器当前版本生成的脚本一起使用。直到今天,我一直只使用它来修改由Microsoft Visual Studio 6附带的编辑器生成的脚本。我不知道Visual Studio团队在1998年至2013年之间进行了哪些破坏性更改。

由于我仍然有将由两个编辑器生成的资源脚本合并的项目,因此保持该程序向后兼容是一个关键的设计目标。

Using the Code

本文有两个目标。

  1. 提供关于在实际世界中日常应用该工作簿的更好说明。
  2. 演示一个涵盖生成和维护任何字符串表的新用例。

下面是对工作簿的引导式游览,使用新用例提供真实世界的例子。

安全措施

为防止意外更改,VBA项目和大部分工作表都受到密码保护。但是,由于您可能希望或需要根据我未预料到的某些要求来编辑工作表或VBA代码,我将为您提供密码。

  • 受保护的工作表: CodeProject
  • VBA项目: TheCodeProject

背景为浅绿色的单元格是未受保护的,可以自由编辑,无需解锁工作表。

由于该项目未签名,如果您有数字签名,则可能希望或需要先对其进行签名,然后再投入生产。为此,您至少需要一次VBA项目密码。

为了方便起见,两个密码都可以在“高级”属性表的“摘要”选项卡中找到的两个段落的文档注释中找到。(鉴于其中的内容,我不知道为什么Microsoft将其标记为“高级”,除非是因为其他选项卡高级的。)

分步指南

以下是图示的分步指南;大部分说明都在图片标题中。

main Resource Script Generator worksheet

图1 是主资源脚本生成器工作表,已准备好创建新任务。

Prompt to Name Task

图2 是当您按下trl-Shift-N来创建新资源配置文件时Microsoft Excel显示的提示。

Populated Task Name Prompt Window

图3图2中显示的输入框,其中输入了一个有效的配置文件名。您可以使用任何不出现在图1中所示的、以E列开始的列组的第4行“字符串表生成配置文件”中的名称。

Completion Confirmation Message

图4 是宏完成工作后的确认提示。工作表中已插入新列,其中包含指向新工作表以及其中包含新资源脚本及其只读符号的两个命名工作簿范围的超链接。

Completed Main Resource Generator Worksheet

图5 是宏结束时出现的图1中所示的第一个工作表。插入点在单元格 F7,位于图4标题中提到的三个新超链接的最后一个下方。除非您添加了想要包含在生成的资源符号头文件中的其他详细信息,否则请将此单元格留空。如果这样做,它们将进入一个命名工作簿范围,并且范围名称将在此处。单击单元格F4中的链接将显示用于输入和命名字符串的新工作表。图6显示的是一个空白工作表。

Blank Resource Strings Worksheet for New Task

图6 是您输入字符串并为其分配名称的空白工作表,可以通过每个配置文件的第4行中的链接访问。单元格A1中的链接将您带回主资源生成器工作表,以完成剩余的配置文件设置。

Completed Resource String Worksheet

图7 是一个已填充的资源字符串工作表。工作表保护功能可确保插入点在您输入C列的资源字符串ID和E列的字符串文本时移动到下一个输入单元格。插入点位于单元格C12,在上一行输入最后一个字符串值后,它就停在这里。D列显示每个名称的长度,工作表公式需要它来计算G列和H列代码的间距。E列是为您在B列生成的字符串ID的十六进制表示。单元格A2包含起始编号,您可以更改它,它由浅绿色背景表示。单击单元格A1中的链接可返回主工作表,完成您的配置文件,生成只读资源脚本及其头文件,并将它们添加到主资源脚本文件中。

Completed Resource Script Profile in Man Resource Generator Worksheet

图8 是已完成的只读资源和符号配置文件,已准备就绪。表1列出了字段并进行了描述。

表1 列出了图8中所示的配置文件表单中剩余的框并进行了描述。列A中的奇怪标签(已冻结)兼作替换标记。

Token 解释
$$StandardErrorStatusCodes$$ 创建用于记录CPP宏,以将退出代码映射到消息ID或反之亦然,在此处输入的任何工作簿命名范围都将成为只读符号头文件$$ReadOnlyResourceScriptName$$.H(向下两个框)的一部分。
$$MainResourceScriptName$$ 输入主资源脚本文件的名称。当任何类型的第一个资源进入项目时,资源编辑器就会创建该文件。例如,由于我总是立即添加版本资源,所以这就是我的资源脚本通常出现的时候。每个项目只有一个,扩展名为.RC。
$$ReadOnlyResourceScriptName$$ 从此框中输入的名称导出两个文件名,我抵抗了将其制作成公式的诱惑,尽管我通常使用配置文件名(单元格F4)。如果您也这样做,请输入=F4到此单元格,这是合法的,因为命名约定可以防止创建任何冲突。
  1. 脚本文件命名为$$ReadOnlyResourceScriptName$$.RC2
  2. 对应的头文件命名为$$ReadOnlyResourceScriptName$$.H
$$ReadOnlyResourceScriptNameUC$$ 此字段受保护,并通过$$ReadOnlyResourceScriptName$$转换为大写后由公式填充,该公式将成为头文件中的保护符号。
$$BookName$$ 此字段已过时,不再使用;完全限定的工作簿名称直接写入只读符号头文件中。
$$Synopsis$$ 在此单元格中输入的任何内容都将被拆分为每行最多80个字符,并写入只读符号头文件顶部的注释框中。

Read Only Resource Script Generation and Integration Succeeded!

图9 是当您按下Ctrl-Shift-G生成资源脚本和符号文件时显示的对话框。

---------------------------
Win32_ResGen_CPPTimeZone.XLSM
---------------------------

Read Only Resource Script and Symbols Header Generated

Resource Script File = C:\Users\DAVE\Documents\Visual Studio 2013\Projects\_Laboratory
\CPPTimeZoneLab\CPPTimeZoneLab\CPPTimeZoneLab.RC2

Header File = C:\Users\DAVE\Documents\Visual Studio 2013\Projects\_Laboratory\CPPTimeZoneLab\CPPTimeZoneLab\CPPTimeZoneLab.H

---------------------------
OK  
---------------------------

列表1图9中对话框的完整内容,通过单击对话框,然后按Ctrl-C,将标题、消息和按钮文本复制到Windows剪贴板来捕获。

Output of Demonstration Program

图10 是我创建的小型演示程序输出,该程序旨在证明生成的脚本插入工作正常。整个项目作为一个嵌套存档CPPTimeZoneLab.ZIP包含在内,该存档使用的资源脚本与生成器留下的完全相同。为了方便起见,我包含了调试版和零售版,两者都已与零售版MSVCR120.LIB构建。

另一个演示项目涵盖了另一种用例,其中资源字符串进入卫星DLL。这个用例本身也很重要,因为它演示了如何通过将一组资源字符串视为字符串库(就像对待通用函数或类库一样)来由两个或多个项目共享。由于上一篇文章深入介绍了这个用例,我在这里将不再赘述。请参阅上一篇文章 “防碰撞共享字符串资源”

关注点

由于本文附带的Microsoft Excel工作簿是“防碰撞共享字符串资源”附带的工作簿的扩展,因此我将仅限于新代码中有趣的部分。这本身就涵盖了大量内容,因为新代码自动化了过程中一个相当复杂且容易出错的部分。

ResGen宏,Ctrl-Shift-G

原始宏ResGen(定义在源文件>m_ResGen.bas中,包含在文章存档中)几乎未作更改,且更改范围非常有限。现有函数LoadTemplateFromRange获得了一个新的可选参数pPreserveBlankLines,该参数在三个调用中只有一个被重写,即处理您输入数据的代码。由于同一个例程处理了来自工作簿命名范围的所有内容,并且目标是保留模板中的空白行,同时丢弃您的输入(因此您可以将空白行留在输入范围的末尾),因此可选值为KEEP_BLANK_LINES,这是一个值为True的布尔常量,适用于除一次调用以外的所有调用。包含您数据的两个范围都由第三个调用处理,该调用重写了可选参数,如下面的列表2所示。

strWork = Replace(strWork, _
                  CStr(rngParams.Cells(lngCurrRow, _
                                       putpParamCols.ColValue).Value), _
                       LoadTemplateFromRange(CStr(rngParams.Cells(lngCurrRow, _
                                                  putpParamCols.ColLiteral).Value), _
                                             LAST_LINE_DLM_DISCARD, _
                                             DISCARD_BLANK_LINES))

列表2 是调用LoadTemplateFromRange的语句,该语句已修改以重写两个可选参数。

由于这是三个调用中唯一重写第一个可选参数的调用,因此为新参数分配一个必须在同一调用中重写的值是有意义的,因为其他两个调用都不需要重写第一个参数,但如果默认值反转,则它们将不得不这样做,因为您不能跳过未使用的可选参数。

函数LoadTemplateFromRange进行了两个更改,以补偿为三个(共四个)数据范围添加的额外行,以支持改进的自动化。

  1. 第一行对应于单列范围中的第一行,如果它包含源范围的名称(由其唯一必需的参数pstrRangeName提供),则会跳过。此直接测试是内联编码的。
  2. 所有行(包括第一行,除非它满足上述测试)都由新的布尔函数KeepOrDiscardLine进行评估,该函数始终将顶部和底部范围边界标记为跳过,并且如果参数pPreserveBlankLinesTrue,则也将空白行标记为跳过。

第二个更改的结果是,直到处理完整个范围后,才能评估参数pfLastNewlineDisp。然而,结果是一个更干净的设计,符合我通常编写追加字符串的循环的方式,这种情况证明了这种方法几乎总是最好的。列表3是改进的循环体,它将保留的行(即使是空白的)追加到字符串strWork中。如果保留空白行,则它们后面必须有一个换行符,最容易通过追加换行符然后是新行来完成,而新行恰好是空字符串。

For lngCurrRow = RANGE_FIRST_ROW To lngLastRow

    Dim strLine As String: strLine = CStr(rngTemplate.Cells(lngCurrRow, _
                                                            THE_ONE_AND_ONLY_COLUMN).Value)

    If lngCurrRow = RANGE_FIRST_ROW And strLine = pstrRangeName Then
        DoEvents            ' The first line contains the range name. Skip it.
    Else
        If KeepOrDiscardLine(strLine, pPreserveBlankLines) Then
            If Len(strWork) = LENGTH_OF_EMPTY_STRING Then
                strWork = strLine
            Else
                strWork = strWork & vbCrLf & strLine
            End If  ' If Len(strWork) = LENGTH_OF_EMPTY_STRING Then
        End If  ' If KeepOrDiscardLine(strLine, pPreserveBlankLines) Then
    End If  ' If lngCurrRow = RANGE_FIRST_ROW And strLine = pstrRangeName Then
Next    ' For lngCurrRow = RANGE_FIRST_ROW To lngLastRow


If pfLastNewlineDisp = LAST_LINE_DLM_KEEP Then
    LoadTemplateFromRange = strWork & vbCrLf
Else
    LoadTemplateFromRange = strWork
End If  ' If pfLastNewlineDisp = LAST_LINE_DLM_KEEP Then

列表3是函数LoadTemplateFromRange中改进的主循环。

Private Function KeepOrDiscardLine(ByRef pstrSourceCodeLine As String, _
                                   ByVal pPreserveBlankLines As Boolean) _
                    As Boolean

'   ----------------------------------------------------------------------------
'   Function Name:      KeepOrDiscardLine
'
'   Function Abstract:  Evaluate the line against four conditions.
'                       1) The line is blank, and is discarded unless
'                          pPreserveBlankLines is TRUE.
'                       2) The line marks the top of a protected named range.
'                       3) The line marks the bottom of a protected named range.
'                       4) The line meets none of the above conditions.
'
'   Function Argument:  Argument pstrSourceCodeLine is the string to evaluate.
'
'                       Argument pPreserveBlankLines is the disposition of blank
'                       lines.
'
'   Function Return:    A member of the LineDisposition corresponds to each of
'                       the four cases listed in the abstract.
'
'   Remarks:            A SELECT CASE block evaluates the line length, which is
'                       very fast, since a Basic String is a counted string,
'                       meaning that its length is determined in advance and
'                       stored with it. Since the string length is sufficient to
'                       evaluate the first condition, it may as well be used as
'                       a first pass, to eliminate strings that are either too
'                       long or too short to meet the next two criteria, leaving
'                       only same length strings that stand a chance of matching
'                       to incur the computational cost of the equality test.
'   ----------------------------------------------------------------------------

    Const MARKER_TOP As String = "This cell marks the top of a range."          ' If MARKER_TOP changes, so must MARKER_TOP_LENGTH.
    Const MARKER_BOTTOM As String = "This cell marks the bottom of a range."    ' If MARKER_BOTTOM changes, so must MARKER_BOTTOM_LENGTH.
    Const MARKER_TOP_LENGTH As Integer = 35                                     ' If MARKER_TOP changes, so must MARKER_TOP_LENGTH.
    Const MARKER_BOTTOM_LENGTH As Integer = 38                                  ' If MARKER_BOTTOM changes, so must MARKER_BOTTOM_LENGTH.

    Select Case Len(pstrSourceCodeLine)
        Case LENGTH_OF_EMPTY_STRING
            KeepOrDiscardLine = pPreserveBlankLines                             ' Disposition of blank lines is encoded in argument pPreserveBlankLines.
        Case MARKER_TOP_LENGTH
            If pstrSourceCodeLine = MARKER_TOP Then
                KeepOrDiscardLine = False
            Else
                KeepOrDiscardLine = True
            End If  ' If pstrSourceCodeLine = MARKER_TOP Then
        Case MARKER_BOTTOM_LENGTH
            If pstrSourceCodeLine = MARKER_BOTTOM Then
                KeepOrDiscardLine = False
            Else
                KeepOrDiscardLine = True
            End If  ' If pstrSourceCodeLine = MARKER_BOTTOM Then
        Case Else
            KeepOrDiscardLine = True
    End Select  ' Select Case Len(pstrSourceCodeLine)

End Function    ' KeepOrDiscardLine

列表4 是函数KeepOrDiscardLine(包括注释)。常量带有行注释,每个注释都以“if”开头,传达了关于字符串和整数常量之间关系的临界维护提醒。

所有VBA字符串对象都是基本字符串,即计数字符串。计数字符串是指在创建时计算其字符并与字符串一起存储的字符串。基本字符串的内部结构(参见图11)由字符串文本组成,前面有一个4字节有符号整数长度。一个推论是,当您追加一个字符串时,会创建一个新字符串,变量会更新为新字符串的地址,并且原始字符串占用的内存会被丢弃(返回到全局堆)。

The Anatomy of a Basic String

11大致展示了基本字符串的内部结构。上面的四个大写L表示长度占据紧邻其地址的位置正下方的4个字节。

由于VBA字符串是计数的,因此获取它们的长度与获取常规ASCIIZ字符串(C字符串)的长度相比非常容易。然而,午餐并非真正免费,因为创建该字符串的程序可能不得不付出努力,因为该字符串很可能以C字符串的形式诞生。但是,如果基本字符串的长度被评估不止一次,那么除第一次评估外,其他所有评估实际上都是免费的;将指针向后移动4个字节,然后从该位置存储的32位有符号整数中读取长度。

从某种意义上说,KeepOrDiscardLine使用了三次长度,但实际上,Select Case只使用一次,并以此为基础来决定下一步做什么。KeepOrDiscardLine的优势在于它最多只需执行一次昂贵的字符串比较。酷不?

新的CreateNewProfile宏,Ctrl-Shift-N

当我告诉我妻子关于这篇文章的事情时,我说这让我想起了她告诉我的一个项目:记录刷牙和使用牙线的步骤。她和她的团队确定了48个离散的步骤!

考虑到这一点,以下是对完全自动化插入工作表列、将模板工作表副本插入到两个指定位置之一的选项卡顺序、在两个私有(工作表范围)范围上覆盖唯一命名的工作簿范围以及创建指向新工作表和插入列的工作表中两个范围的链接,并使该工作表保持激活状态、插入点停留在包含新工作表超链接的单元格下方三行的所有步骤的详细介绍。虽然我可能仍然遗漏了一些东西,但我试图预测所有可能出错的事情,并在可能的情况下恢复,在不可能的情况下恢复到原始状态。

主工作表ResGen Parameters包含驱动此宏的两个命名范围。

  1. 工作簿范围ActiveProfileName解析为单元格C4,该单元格是存储活动任务名称(也是其数据工作表的名称)的验证输入单元格。由于此范围具有工作簿范围,因此其Worksheet属性用于选择和激活ResGen Parameters工作表,无论宏启动时哪个工作表具有焦点。
  2. 工作表范围Active_Task是横跨标有“字符串表生成配置文件”的列的单元格行;它从单元格E4开始,向右延伸至其上方的标签单元格(当前为单元格H4)。当此宏不使用它时,此范围会验证对ActiveProfileName单元格的输入。由于在其他地方没有其他用途,因此其范围是工作表ResGen Parameters

另外两个范围Substitution_Token_LabelsValidSubstitutionTokens(均具有工作簿范围)支持由Ctrl-Shift-G激活的资源脚本生成器宏。自定义对象clsRCScriptRangeCollection(一个RCScriptRangeCollection)是一个小对象,用于存储关于两个新范围的信息,这些信息对于创建任务列中第5行和第6行中的超链接至关重要。工作表对象wksResGen获取到工作表ResGen Parameters的引用,以便可以使用其Activate方法跳转回该工作表以填充第5行和第6行。

With rngTaskList块的目的是在存储活动配置文件(最近使用的那个)信息的列的左侧插入一列,以保存即将出现的任务的元数据。

第一个看起来可能奇怪的测试是第126行的测试,它确定宏是否执行任何工作:If rngStartHere Is Nothing Then,并且依赖于未初始化的对象为Nothing的事实。如果执行到达此测试而没有设置rngStartHere(在第96行定义,位于扫描已注册任务列表的简短with块上方),则For Each rngCurrTask In .Cells中的测试未满足,因为工作表处于不一致状态。

函数GetNewTaskName使用操作员输入的任务名称初始化字符串strNewTaskName。如果字符串strNewTaskName为空,则通过调用子例程UndoChanges(如下所述)来撤销With rngTaskList所做的列插入。否则,真正的工作就开始了。

  1. 任务名称存储在构成逻辑范围rngStartHere的单个单元格中,该单元格是刚刚插入的列的第4行中的单元格。将任务名称存储在此单元格中可以将其添加到可以为生成器选择的任务列表中,并提供设置焦点到定义其字符串的工作表的超链接的标签。我使用逻辑来区分这个无名范围(仅在此子例程的上下文中存在)与在工作簿及其工作表中定义的命名范围。
  2. 下一个测试将IsSheetNameAvailable颠倒过来,通过要求它在字符串表模板工作表缺失时发出红色警报。
  3. 除非模板工作表缺失是因为操作员意外删除并保存了工作簿,否则将搜索工作簿中为活动(最后使用的)任务创建的工作表。如果存在,则新工作表插入到其前面。否则,新工作表将插入到原始工作表StringTable_Template(程序常量TASK_TEMPLATE)的前面。
  4. 无论是在用户界面中手动完成还是通过代码完成,复制工作表都会激活副本,并且工作表对象wksScriptData会获得对新工作表的引用,然后将其连同clsRCScriptRangeCollection一起传递给函数LabelRC,后者会验证工作表的完整性并创建驱动资源脚本生成器脚本的两个工作簿范围命名。
  5. 除非LabelRC遇到障碍(不太可能,但总是可能),否则函数CreateHyperlinksInResGen会将工作表ResGen Parameters中新列的第4行到第6行转换为超链接。
  6. 除非CreateHyperlinksInResGen遇到麻烦(不太可能),否则将激活工作表ResGen Parameters,将新任务设为活动状态(其名称将放入单元格C4),并将选择移至第7行的空单元格,并在宏结束时离开。
  7. 消息框会通知您新配置文件已完成并可以使用,并且将重新对工作表ResGen Parameters施加保护。

这七个步骤,包括几个多步任务,几乎在一眨眼之间就完成了,并且消除了许多耗时且易出错的手动过程,无论您有多熟练。这七个步骤可以分解为许多更小的步骤和决策。以下各节将讨论完成这7个步骤的大部分工作的功能。各节按函数名称的字母顺序列出。

CreateHyperlinksInResGen

在工作表ResGen Parameters上锚定到宏开始的位置后,将在用于存储字符串定义的新工作表的原点(单元格A1)处定义一个新的逻辑范围,并将两者结合起来,将新列的第4行中的单元格转换为可用于激活该工作表的超链接。

接下来,定义并初始化一个新的enmLabelColumn变量,这与函数LabelRC顶部的操作完全相同,后者是驱动它的相同DO循环的索引。不同之处在于,此循环中执行的任务少得多。尽管只有三个迭代,其中最后一个跳过了主体,但这种设计提供了通过将其添加到驱动它的enmLabelColumn枚举来扩展以涵盖更多范围的选项。

循环的第一个任务是调用方法pclsRCScriptRangeCollection.GetRangeName,它使用一个简单的Select Case来获取用作工作表ResGen ParametersHyperlinks集合的Add方法的命名参数TextToDisplay的字符串,该字符串将单元格转换为有效的超链接。

除非pclsRCScriptRangeCollection.GetRangeName返回的字符串为空(因为它遇到了问题,不太可能),否则pclsRCScriptRangeCollection.GetRange将获取相应范围对象的引用,然后函数RangeAddressForFrmula从中派生出上述Add方法的SubAddress命名参数的有效值。

虽然我不记得我是如何学会构建本地超链接的,但这并不重要,因为我有一些来自创建此工作簿中的_Index工作表的VBA加载项的有效代码。您可以通过命名参数SubAddress指定本地超链接的目标,而Anchor参数定义它在工作表上的位置,该位置不一定是活动工作表。

GetNewTaskName

该例程的测试暴露出一个问题,源于它使用Application对象的InputBox方法,即当您跨越单元格范围拖动鼠标时,输入框中会显示相应的范围,如果您不注意并接受输入,则返回原始单元格的内容。我最初阅读文档时,曾添加了额外的案例来覆盖vbObject变体类型。第二次阅读,由于上述行为促使我,我确认除非您重写一个默认为Text的可选参数,否则您不会得到Range对象。这仍然存在原始单元格中的文本进入控件的问题,并最终导致创建了一个新函数MakeRangeNameConformant,该函数在尝试使用它们之前清理范围名称。

列表5 是函数GetNewTaskName的全部内容,它有几个值得注意的特性。

  • 第一个可执行语句调用Application.InputBox,这是Application对象的一个方法,它与旧的InputBox函数不同,因为它提供了一种明确确定操作员激活了其Cancel按钮的机制,并且它可以返回对工作表范围的引用,尽管此宏忽略了此功能。
  • 由于Application.InputBox可以返回Range对象、文本或其Cancel按钮被激活的指示符,因此其返回类型为Variant
  • 由于激活Application.InputBox上的Cancel按钮会导致它返回一个Boolean,因此返回后要执行的第一个任务是评估其类型,这取决于VarType函数,其返回值是包含DO循环其余部分和例程的Select Case语句的标准。
  • 在正常情况下,Case vbString块执行,因此位于该块的顶部。这会影响程序性能,因为Select Case按顺序评估每个case,直到满足一个case或它用完所有case。
  • 一旦使用CStr函数将InputBox返回的Variant转换为真正的StringvbString块就会将注意力转向其长度,该长度首先测试是否为(表示输入框在按下OK按钮时为空),然后测试是否大于MAX_SHEETNAME_LENGTH31)。我将这些测试分开,因为它们的处理方式不同,因为后一种情况会在消息框中显示输入字符串及其长度,而零长度字符串会获得一个没有插入的简单消息。
    • 有两种处理插入的方法,我的选择取决于我是否将静态文本直接放入MsgBox函数调用或常量中。我更喜欢商业级代码的常量,因为它们可以放在程序顶部附近,便于查找。
    • 这种方法偏向于用作运行时插入值的占位符的替换标记。为了确保标记的正确性,我将它们定义为独立的常量,它们不仅作为Replace函数的参数,而且还用于构建模板字符串本身。
    • 虽然我很少看到以这种方式定义常量的例子,但当我意识到常量定义可以是任何对其类型有效的表达式时,我感到非常高兴。这不仅减小了程序在磁盘和内存中的大小,而且使得健壮、无错误的邮件模板变得容易!
    • 如果你的大部分代码是C、C++、C#和VB.NET,很容易忘记VBA编译器在定义元素的顺序方面不是很宽容,所以你必须在定义模板常量之前定义替换标记。
  • 我使用嵌套的Replace函数来替换字符串中的两个或多个标记,因为它们不会用一次性临时变量使代码混乱,并且更有效地使用堆栈。如果将它们格式化如下,则很容易正确设置它们,因为它会创建标记及其替换的图形。
  • 为了让你有机会退出,这个例程显示的每个提示都有一个Cancel按钮,需要消息框使用MsgBox函数,该函数返回一个值来指示选定的按钮,而不是经典的MsgBox语句,它返回void。由于我们没有其他用途来使用返回值,因此MsgBox直接放入Select Case语句中,而不是用更多一次性变量来使代码混乱。
  • 最后,测试BooleanTrue值并在Case Else块中捕获其他变体类型是防御性措施。除非InputBox的行为发生变化(这不太可能,但理论上是可能的),否则这两个块都不会执行。但是,如果它们执行,它们会给你一些关于意外行为原因的线索。
Private Function GetNewTaskName() As String

    Const MAX_SHEETNAME_LENGTH As Integer = 31
   
    '   ------------------------------------------------------------------------
    '   Interpolating constants into other constant strings is legal, but their
    '   names must first be defined. The VBA lexer doesn't look ahead.
    '   ------------------------------------------------------------------------

    Const TOKEN_CANDIDATE As String = "$$Candidate$$"
    Const TOKEN_STRLEN As String = "$$StrLen$$"
    Const TOKEN_BAD_TYPENAME As String = "$$TypeName$$"
    Const TRY_AGAIN_PROMPT As String = vbLf & vbLf & "Please choose a different name."
    Const WARNING_IF_PERSISTS As String = vbLf & "Please investigate if this error persists."

    Const MSG_NAME_HAS_INVALID_CHARS As String = "The name you entered, " & TOKEN_CANDIDATE & ", contains invalid characters." & "The following characters are invlid:  :  \  /  ?  *  [  ]" & TRY_AGAIN_PROMPT
    Const MSG_NAME_IS_BLANK As String = "Your input registered as the empty string. Please try again."
    Const MSG_NAME_TOO_LONG As String = "The name you entered, " & TOKEN_CANDIDATE & "," & vbLf & "contains " & TOKEN_STRLEN & " characters, which is too long." & vbLf & vbLf & "Please enter a name that contains 31 or fewer characters." & TRY_AGAIN_PROMPT
    Const MSG_NO_RANGES_PLEASE As String = "You accidentally selected a range from the worksheet." & vbLf & "This input box needs a name that it can assign to a new worksheet." & vbLf & vbLf & "Please input your selection again."
    Const MSG_UNAVAILABLE As String = "The name you entered, " & TOKEN_CANDIDATE & ", belongs to another task and its worksheet." & TRY_AGAIN_PROMPT
    Const MSG_UNEXPECTED_VALUE As String = "The Input Box returned an unexpected Boolean value." & WARNING_IF_PERSISTS
    Const MSG_UNEXPECTED_TYPE As String = "The input box returned an unexpected Variant type of " & TOKEN_BAD_TYPENAME & "." & WARNING_IF_PERSISTS

    Const NAME_PROMPT As String = "Enter a name for the new task. The selected name will become the name of its worksheet. Hence, it cannot be the name of an existing worksheet."

    Const TYPENAME_RANGE As String = "Range"

    Dim fNameInHand As Boolean: fNameInHand = False

    Do
        Dim fGoodCandidate As Boolean: fGoodCandidate = True
        Dim varCandidateName As Variant: varCandidateName = Application.InputBox(NAME_PROMPT, _
                                                                                 ActiveWorkbook.Name, _
                                                                                 vbNullString)

        Select Case VarType(varCandidateName)
            Case vbString
                Dim strCandidateName As String: strCandidateName = CStr(varCandidateName)               

                Dim intStrLen As Integer: intStrLen = Len(strCandidateName)

                If intStrLen = LENGTH_OF_EMPTY_STRING Then
                    fGoodCandidate = False

                    Select Case MsgBox(MSG_NAME_IS_BLANK, _
                                       vbOKCancel Or vbExclamation, _
                                       ActiveWorkbook.Name)
                        Case vbOK
                            DoEvents                          ' Go around.
                        Case vbCancel
                            GetNewTaskName = vbNullString     ' Returning the empty string signals cancellation.
                            fNameInHand = True                ' Force DO loop to end.
                    End Select  ' Select Case MsgBox(MSG_NAME_IS_BLANK, vbOKCancel Or vbExclamation, ActiveWorkbook.Name)
                ElseIf intStrLen > MAX_SHEETNAME_LENGTH Then
                    fGoodCandidate = False

                    Select Case MsgBox(Replace(Replace(MSG_NAME_TOO_LONG, _
                                                       TOKEN_CANDIDATE, _
                                                       strCandidateName), _
                                                TOKEN_STRLEN, _
                                                intStrLen), _
                                        vbOKCancel Or vbExclamation, _
                                        ActiveWorkbook.Name)
                        Case vbOK
                            DoEvents                          ' Go around.
                        Case vbCancel
                            GetNewTaskName = vbNullString     ' Returning the empty string signals cancellation.
                            fNameInHand = True                ' Force DO loop to end.
                    End Select  ' Select Case MsgBox(Replace(Replace(MSG_NAME_TOO_LONG, TOKEN_CANDIDATE, strCandidateName), TOKEN_STRLEN, intStrLen), vbOKCancel Or vbExclamation, ActiveWorkbook.Name)
                ElseIf SheetNameIsInvalid(strCandidateName) Then
                    fGoodCandidate = False

                    Select Case MsgBox(Replace(MSG_NAME_HAS_INVALID_CHARS, _
                                               TOKEN_CANDIDATE, _
                                               strCandidateName), _
                                       vbOKCancel Or vbExclamation, _
                                       ActiveWorkbook.Name)
                        Case vbOK
                            DoEvents                          ' Go around.
                        Case vbCancel
                            GetNewTaskName = vbNullString     ' Returning the empty string signals cancellation.
                            fNameInHand = True                ' Force DO loop to end.
                    End Select  ' Select Case MsgBox(Replace(MSG_NAME_HAS_INVALID_CHARS, TOKEN_CANDIDATE, strCandidateName), vbOKCancel Or vbExclamation, ActiveWorkbook.Name)
                End If  ' If intStrLen = LENGTH_OF_EMPTY_STRING Then

                If fGoodCandidate Then
                    If IsSheetNameAvailable(strCandidateName) Then
                        GetNewTaskName = strCandidateName     ' Name is available; return it to caller.
                        fNameInHand = True                    ' Force DO loop to end.
                    Else
                        Select Case MsgBox(Replace(MSG_UNAVAILABLE, _
                                                   TOKEN_CANDIDATE, _
                                                   strCandidateName), _
                                           vbOKCancel Or vbExclamation, _
                                           ActiveWorkbook.Name)
                            Case vbOK
                                DoEvents                      ' Go around.
                            Case vbCancel
                                GetNewTaskName = vbNullString ' Returning the empty string signals cancellation.
                                fNameInHand = True            ' Force DO loop to end.
                        End Select  ' Select Case MsgBox(Replace(MSG_UNAVAILABLE, TOKEN_CANDIDATE, strCandidateName), vbOKCancel, ActiveWorkbook.Name)
                    End If  ' If IsSheetNameAvailable(strCandidateName) Then
                End If  ' If fGoodCandidate Then

            Case vbBoolean                                                      ' Either way, we are done.
                If CBool(varCandidateName) Then
                    Select Case MsgBox(MSG_UNEXPECTED_VALUE, _
                                       vbOKCancel Or vbCritical, _
                                       ActiveWorkbook.Name)
                        Case vbOK
                            DoEvents                          ' Go around.
                        Case vbCancel
                            GetNewTaskName = vbNullString     ' Returning the empty string signals cancellation.
                            fNameInHand = True                ' Force DO loop to end.
                    End Select  ' Select Case MsgBox(MSG_UNEXPECTED_VALUE, vbOKCancel Or vbCritical, ActiveWorkbook.Name)
                End If  ' If CBool(varCandidateName) Then

                GetNewTaskName = vbNullString                 ' Returning the empty string signals cancellation.
                fNameInHand = True                            ' Force DO loop to end.
            Case Else                                         ' In the unlikely event that this happens, I'll take the hit for the extra vartype.
                MsgBox Replace(MSG_UNEXPECTED_TYPE, _
                               TOKEN_BAD_TYPENAME, _
                               TypeNameForVariant(VarType(varCandidateName))), _
                       vbCritical, _
                       ActiveWorkbook.Name
        End Select  ' Select Case VarType(varCandidateName)

    Loop Until fNameInHand

End Function    ' GetNewTaskName

列表5 是VBA函数GetNewTaskName,它在大多数情况下都很直接,但有一些值得注意的怪癖。

IsSheetNameAvailable

这个函数本身就值得注意,因为它实现了一个循环,该循环枚举Worksheets集合,将每个工作表的Name与提议的名称进行比较。虽然枚举列表可能看起来成本很高,但我更喜欢它而不是所谓的更简单的方法——按名称查找工作表。第一,我对此有一些零星的运气,第二,如果工作表不存在,这种方法会引发运行时错误,我极力避免,因为它们会破坏程序流程。(我认为你可以有充分的理由说On Error GoTo是有害的GoTo。)列表6是整个函数,其中注释占代码的比例很高。

  • 第一个任务是验证工作表名称字符串是否包含文本,以避免浪费时间在列表中搜索空字符串(它永远不会匹配工作表名称),从而将其转化为一个通用的好函数。如果名称为空,函数将其返回值设置为False,因为严格来说,空名称是不可用的,然后返回。
  • 接下来,函数将其返回值设置为True,预计指定名称可用,设置错误陷阱,并进入主循环。
  • 虽然它不应该遇到运行时错误,但如果发生这种情况,错误将通过消息框报告,返回值将更改为False,然后函数返回。
  • 如果找到匹配的名称,函数将其返回值设置为False,跳出循环,然后返回而不搜索列表的其余部分。
  • 如果循环结束是因为它扫描了整个列表而没有找到匹配项,则函数直接返回,因为返回值已经是True
Public Function IsSheetNameAvailable(ByRef pstrProposedName As String) As Boolean

'   ----------------------------------------------------------------------------
'   Function Name:      IsSheetNameAvailable
'
'   Function Abstract:  Return TRUE if a proposed worksheet name is available
'                       for assignment to a new worksheet.
'
'   Function Arguments: pstrProposedName (String) = proposed worksheet name
'
'   Function Returns:   TRUE if the name is avaliable for use, otherwise FALSE
'
'   Remarks:            In the unlikely event of a run-time error, the function
'                       reports via message box, then returns FALSE. The enpty
'                       string also elicits a return value of FALSE, for reasons
'                       that I presume are self-evident.
'   ----------------------------------------------------------------------------

    If Len(pstrProposedName) = LENGTH_OF_EMPTY_STRING Then
        IsSheetNameAvailable = False
    Else
        On Error GoTo IsSheetNameAvailable_Err                                  ' Defer wiring up the exception handler until we know it's needed.
        IsSheetNameAvailable = True                                             ' Anticipating that the name is available is more computationally fficient.

        Dim wksCurrent As Worksheet

        For Each wksCurrent In ThisWorkbook.Worksheets
            If wksCurrent.Name = pstrProposedName Then
                IsSheetNameAvailable = False                                    ' Signal that the name belongs to another sheet.
                Exit For                                                        ' Finding a match ends the search.
            End If  ' If wksCurrent.Name = pstrProposedName Then
        Next    ' For Each wksCurrent In ThisWorkbook.Worksheets
    End If  ' If Len(pstrProposedName) = LENGTH_OF_EMPTY_STRING Then

IsSheetNameAvailable_End:

    Exit Function

IsSheetNameAvailable_Err:

    MsgBox "Error report from custom VBA function IsSheetNameAvailable:" & vbLf & vbLf _
                & "Error " & Err.Number & " - " _
                & Err.Description, _
            vbExclamation, _
            ThisWorkbook.Name
    Err.Clear

    IsSheetNameAvailable = False
    Resume IsSheetNameAvailable_End

End Function    ' IsSheetNameAvailable

列表6 是函数IsSheetNameAvailable(包括注释)。

LabelRC

此模块定义了两个工作簿范围的命名范围,它们指定了资源脚本和相应符号的代码。由于此例程与驱动CreateHyperlinksInResGen的例程相同,因此我不再重复解释。

  1. 此例程中的大部分代码都用于验证工作表的完整性,其中有两个方面。
    1. 范围的几何形状是否正确,表明其两个边界行完好无损,并且没有添加列?
    2. 标签行是否完好(未从设计时值更改),表明工作表未使用?
  2. 函数MakeRangeNameConformant解决了游戏中后期出现的一个问题,尽管我应该记得空格在范围名称中是非法的。然而,由于我通常为几乎所有东西(包括文件和范围)使用下划线和驼峰命名法,我直到开始尝试完全随机的字符串作为范围名称来测试Application.InputBox方法的另一个怪癖时才忘记了这一点。哎呀!不过没关系,因为它促使我确切地了解了什么构成有效的范围名称,什么不构成有效的范围名称,从而产生了MakeRangeNameConformant[1]
  3. 由于具有局部(工作表)范围的范围的Name属性,例如此范围,返回其完全限定的地址,因此此例程会绕过RANGEADDRESSFORFRMULA

由于此例程在结构上与CreateHyperlinksInResGen相同,因此省略了其源代码,以防止文章篇幅过长。

MakeRangeNameConformant。 

此函数实现了脚注1中引用的文章中列出的名称语法规则。其算法基本上是Excel用户界面在使用Ribbon“公式”选项卡“定义的名称”部分中的“从选择创建”选项时使用的算法,不同之处在于,前导反斜杠会变成前导下划线。

规则归结为这一点。

  • 名称的第一个字符必须是字母、数字或反斜杠。如果第一个字符是数字,您可以保留它,但只能在前面加上一个下划线,使其成为第二个字符。
  • 后续字符可以是字母、数字、句点和下划线。
  • 名称不能包含超过255个字符。

MakeRangeNameConformant用下划线替换无效字符,除非第一个字符是数字,前面有一个下划线并被保留。此函数在第一个字符方面偏离了官方规则,因为它将前导反斜杠视为无效,并将其替换为下划线。

处理第二个及后续字符的循环在一定程度上偏离了我通常避免在循环的准则子句中使用函数调用的做法,IIf(intStrLen > MAX_LENGTH, MAX_LENGTH, intStrLen)。这个紧凑的表达式有效地在第255个字符之后截断处理,即使有更多字符,这种情况也很少见。整个例程在列表7中重现。

Public Function MakeRangeNameConformant(ByRef pstrCandidate As String) As String

'   ----------------------------------------------------------------------------
'   Name:               MakeRangeNameConformant
'
'   Abstract:           Transform any string into a valid name for a Range.
'
'   Arguments:          pstrCandidate   = Name to transform
'
'   Returns:            Unless the string is enpty, a new string is returned in
'                       which illegal characters are replaced with underscores.
'                       If the first character is a number, it is prefixed with
'                       an underscore, so that the digit, which is legal in any
'                       other position, can stay. If the length of the input
'                       string exceeds 255 characters, the excess is truncated.
'
'   Remarks:            Private function CharIsValidinRangeName, defined in this
'                       module, evaluates each character in the name.
'   ----------------------------------------------------------------------------

    Const MAX_LENGTH As Integer = 255

    Dim intStrLen As Integer: intStrLen = Len(pstrCandidate)
    Dim intCurrPos As Integer

    If intStrLen > LENGTH_OF_EMPTY_STRING Then
        Dim strTemp As String
        Dim strCurrChar As String: strCurrChar = Left(pstrCandidate, INSTR_START_AT_BEGINNING)

        '   --------------------------------------------------------------------
        '   Unsurprisingly, the first character is a special case.
        '   --------------------------------------------------------------------

        If IsNumeric(strCurrChar) Then
            strTemp = CHAR_UNDERSCORE & strCurrChar
        Else
            If CharIsValidinRangeName(pstrCandidate, INSTR_START_AT_BEGINNING) Then
                strTemp = strCurrChar
            End If  ' If CharIsValidinRangeName(pstrCandidate, INSTR_START_AT_BEGINNING) Then
        End If  ' If IsNumeric(Left(pstrCandidate, 1)) Then

        '   --------------------------------------------------------------------
        '   The remaining characters are treated identically.
        '
        '   Limit expression IIf(intStrLen > MAX_LENGTH, MAX_LENGTH, intStrLen)
        '   effectively truncates the string, since it stops the append loop at
        '   the 255th character.
        '   --------------------------------------------------------------------

        For intCurrPos = SECOND_CHARACTER To IIf(intStrLen > MAX_LENGTH, MAX_LENGTH, intStrLen)
            If CharIsValidinRangeName(pstrCandidate, intCurrPos) Then
                strTemp = strTemp & Mid(pstrCandidate, _
                                        intCurrPos, _
                                        ONE_CHAR_ONLY)
            Else
                strTemp = strTemp & CHAR_UNDERSCORE
            End If  ' If CharIsValidinRangeName(strCurrChar, intCurrPos) Then
        Next    ' For intCurrPos = SECOND_CHARACTER To IIf(intStrLen > MAX_LENGTH, MAX_LENGTH, intStrLen)

        MakeRangeNameConformant = strTemp
    Else
        MakeRangeNameConformant = vbNullString
    End If  ' If Len(pstrCandidate) > LENGTH_OF_EMPTY_STRING Then

End Function    ' MakeRangeNameConformant

列表7 是函数MakeRangeNameConformant的全部内容。它与伴随函数CharIsValidinRangeName一起使用,可以将任何字符串(空字符串除外,空字符串无法挽救)转换为有效的范围名称。

CharIsValidinRangeName对字符串中的每个字符调用一次以进行确定,但当初始字符是数字时除外,这种情况由MakeRangeNameConformant内联处理。由于Excel仍然牢牢地固定在ANSI时代,评估字符组的最简单方法是派生代表每个字符的整数代码,然后对数字进行范围检查。Select Case块处理特殊情况(反斜杠、下划线和句点),而其Case Else块中的范围检查可以快速处理其余部分。

Private Function CharIsValidinRangeName(ByRef pstrCandidate As String, _
                                        ByVal pintPosition As Integer) _
                    As Boolean

'   ----------------------------------------------------------------------------
'   Name:               CharIsValidinRangeName
'
'   Abstract:           Evaluate the validity of a charecter in a proposed range
'                       name based on its position in the string.
'
'   Arguments:          pstrCandidate   = Name to transform
'
'                       pintPosition    = Position of character to evaluate.
'
'   Returns:            TRUE if the character is valid at the specified position, else FALSE.
'
'   Remarks:            This function begins by invoking intrinsic function ASC
'                       to return the integer ASCII code of the character under
'                       evaluation, so that the evaluation consists entirely of
'                       numeric comparisons, of which the frist three degenerate
'                       cases are dispatched by the select case block. The rest
'                       are evaluated by range testing, starting with upper case
'                       letters, then lower case letters, and, finally, digits.
'
'                       While the first of the three cases is dispatched with a
'                       simple response of TRUE, whether the second and third of
'                       them returns TRUE depends on whether the character under
'                       the microscope is the first or a subsequent character.
'                       It takes advantage of the fact that, when a relational
'                       expression is assigned to a Boolean variable, it is set
'                       to TRUE if the expression is TRUE, and FALSE otherwise.
'
'                       MakeRangeNameConformant is the only function that calls
'                       this routine, which it does once for each character in a
'                       string, up to the length limit of 255 for a range name.
'   ----------------------------------------------------------------------------

    Const CODE_BACKSLASH As Integer = 92
    Const CODE_FULL_STOP As Integer = 46
    Const CODE_UNDERSCORE As Integer = 95

    Const CODE_DECIMAL_DIGIT_0 = 48
    Const CODE_DECIMAL_DIGIT_9 = 57

    Const CODE_UC_LETTER_FIRST = 65
    Const CODE_UC_LETTER_LAST = 90

    Const CODE_LC_LETTER_FIRST = 97
    Const CODE_LC_LETTER_LAST = 122

    '   ------------------------------------------------------------------------
    '   Although ASC would swallow the rest of the string whole, why waste the
    '   memory and CPU cycles to store extra characters that it will ignore?
    '   ------------------------------------------------------------------------

    Dim intCharCode As Integer: intCharCode = IIf(pintPosition = INSTR_START_AT_BEGINNING, _
                                              Asc(pstrCandidate), _
                                              Asc(Mid(pstrCandidate, pintPosition, ONE_CHAR_ONLY)))


    Select Case intCharCode
        Case CODE_UNDERSCORE
            CharIsValidinRangeName = True
        Case CODE_BACKSLASH
            CharIsValidinRangeName = (pintPosition = INSTR_START_AT_BEGINNING)
        Case CODE_FULL_STOP
            CharIsValidinRangeName = (pintPosition > INSTR_START_AT_BEGINNING)
        Case Else
            If intCharCode >= CODE_DECIMAL_DIGIT_0 And intCharCode <= CODE_DECIMAL_DIGIT_9 Then
                CharIsValidinRangeName = (pintPosition > INSTR_START_AT_BEGINNING)
            ElseIf intCharCode >= CODE_UC_LETTER_FIRST And intCharCode <= CODE_UC_LETTER_LAST Then
                CharIsValidinRangeName = True
            ElseIf intCharCode >= CODE_LC_LETTER_FIRST And intCharCode <= CODE_LC_LETTER_LAST Then
                CharIsValidinRangeName = True
            Else
                CharIsValidinRangeName = False
            End If  ' If intCharCode >= CODE_UC_LETTER_FIRST And intCharCode <= CODE_UC_LETTER_LAST Then
    End Select  ' intCharCode

End Function    ' CharIsValidinRangeName

列表8 是函数CharIsValidinRangeName的全部内容,该函数由MakeRangeNameConformant为Proposed Range Name字符串中的每个字符调用一次,最多可达255个字符的允许长度。

RangeAddressForFrmula

从Excel中提取有效的范围地址并不像我认为的那样容易。人们可能会认为这只是获取其属性值的问题。然而,对我曾经评估过的每个范围来说,AddressAddressLocal都返回本地地址,例如$A$1:$G$10

为了进一步复杂化,尽管工作表名称中允许空格以及许多其他您认为被禁止的字符,但包含这些字符的工作表名称必须用引号(ASCII码0390x27))括起来。

最后,要创建有效的绝对(完全限定)范围地址,您必须将工作表名称(如果需要则引用)和绝对本地地址连接起来,中间夹着一个感叹号(!,ASCII码0330x21)。使用未充分利用的Immediate IF(IIF)函数,这只需要一个语句,但它是一个大语句(列表9)。

    RangeAddressForFrmula = IIf(InStr(prng.Worksheet.Name, SPACE_CHAR_WW) > INSTR_NOT_FOUND, _
                                QUOTE_CHAR_SGL_WW _
                                & prng.Worksheet.Name _
                                & QUOTE_CHAR_SGL_WW, _
                                prng.Worksheet.Name) _
                            & FORMULA_SHEET_NAME_DLM _
                            & prng.AddressLocal

列表9 是函数RangeAddressForFrmula中唯一可执行的语句,这要归功于未充分利用的IIF函数。

趣味问答:有多少人记得Lotus 1-2-3手册将这种地址称为绝对引用,而1-2-3用户的领先技术通讯也叫这个名字?

UndoChanges

通过对新任务工作表、ResGen Parameters工作表以及RCScriptRangeCollection对象的引用进行操作,此例程可以撤销宏所做的所有更改,使工作簿恢复到原始状态。即使RCScriptRangeCollection对象存在,其属性也未初始化,直到相关对象成为工作簿的一部分之后。

代码很简单;最值得注意的怪癖是它如何处理Application.DisplayAlerts属性,该属性涵盖了属性已关闭的罕见但技术上可行的可能性。如果碰巧是这种情况,意外地将其保持打开状态可能会对别人的工作造成毁灭性的后果。因此,其状态会得到测试。如果最初是打开的,它将被暂时关闭,以防止删除空白任务工作表时出现提示,然后恢复。如果最初是关闭的,工作表将被删除,不再进行任何进一步的操作,并且将按原样保留。

Public Sub UndoChanges(Optional ByRef pwksNewTaskData As Worksheet = Nothing, _
                       Optional ByRef pwksResGenMain As Worksheet = Nothing, _
                       Optional ByRef pclsRCScriptRangeCollection As RCScriptRangeCollection = Nothing)

    On Error GoTo UndoChanges_Err

    Dim fGoForNextStep As Boolean: fGoForNextStep = True

    '   ------------------------------------------------------------------------
    '   If the caller included a worksheet reference in pwksNewTaskData, it goes
    '   away.
    '   ------------------------------------------------------------------------

    If pwksNewTaskData Is Nothing And pwksResGenMain Is Nothing Then
        DoEvents
    Else
        pwksResGenMain.Activate                                                 ' Activate the main ResGen worksheet.

        '   --------------------------------------------------------------------
        '   Though DisplayAlerts is ON by default, in the unlikely event that it
        '   has been disabled, it is bad form to assume the flag is ON. Hence,
        '   this code tests the current state of the flag. If it is ON, it is
        '   temporarily turned OFF, to suppress a prompt for permission from the
        '   user to delete a sheet that he cannot possibly have yet seen, let
        '   alone populated. Otherwise, the sheet is deleted, and the prompt is
        '   left OFF.
        '   --------------------------------------------------------------------

        If Application.DisplayAlerts = True Then
            Application.DisplayAlerts = False
            pwksNewTaskData.Delete                                              ' Delete the new worksheet.
            Application.DisplayAlerts = True
        Else
            pwksNewTaskData.Delete                                              ' Just do it.
        End If  ' If Application.DisplayAlerts = True Then
    End If  ' If pwksNewTaskData Is Nothing And pwksResGenMain Is Nothing Then

    '   ------------------------------------------------------------------------
    '   If the caller specified range name pstrRCScriptRangeName, delete it.
    '   ------------------------------------------------------------------------

    If fGoForNextStep Then
        If Not pclsRCScriptRangeCollection Is Nothing Then
            If Not pclsRCScriptRangeCollection.StringDetails Is Nothing Then
                If UndoWorkbookRange(pclsRCScriptRangeCollection.StringDetailsRngNm) Then
                    DoEvents
                Else
                    fGoForNextStep = False
                End If  ' If UndoWorkbookRange(pstrRCScriptRangeName) Then
            End If  ' If Not pclsRCScriptRangeCollection.StringDetails Is Nothing Then
        End If  ' if not pclsRCScriptRangeCollection is nothing then
    End If  ' If fGoForNextStep Then

    '   ------------------------------------------------------------------------
    '   If the caller specified range name pstrRCSymbolsRangeName, delete it.
    '   ------------------------------------------------------------------------

    If fGoForNextStep Then
        If Not pclsRCScriptRangeCollection Is Nothing Then
            If Not pclsRCScriptRangeCollection.ResourceIDs Is Nothing Then
                If UndoWorkbookRange(pclsRCScriptRangeCollection.ResourceIDRngNm) Then
                    DoEvents
                Else
                    fGoForNextStep = False
                End If  ' If UndoWorkbookRange(pstrRCSymbolsRangeName) Then
            End If  ' If Not pclsRCScriptRangeCollection.ResourceIDs Is Nothing Then
        End If  ' if not pclsRCScriptRangeCollection is nothing then
    End If  ' If fGoForNextStep Then

    '   ------------------------------------------------------------------------
    '   There is always a column insertion to undo.
    '   ------------------------------------------------------------------------

    If fGoForNextStep Then
        If UndoColumnInsert() Then
            MsgBox MSG_TASK_CANCELED, _
                   vbInformation, _
                   ActiveWorkbook.Name
        Else
            MsgBox ERRMSG_002, _
                   vbCritical, _
                   ActiveWorkbook.Name
        End If  ' If UndoColumnInsert() Then
    End If  ' If fGoForNextStep Then

UndoChanges_End:

    Exit Sub

UndoChanges_Err:

    MsgBox "Error report from custom VBA function UndoChanges:" & vbLf & vbLf _
                & "Error " & Err.Number & " - " _
                & Err.Description, _
            vbExclamation, _
            ThisWorkbook.Name
    Err.Clear
    Resume UndoChanges_End

End Sub         ' UndoChanges

列表10 是函数UndoChanges的全部内容。它与其辅助函数UndoWorkbookRangeUndoColumnInsert(未显示)一起工作,可以在宏进行的任何阶段(从刚开始到几乎完成)撤销所做的更改。

结束语

这个项目让我想起了为什么你必须准备花比你最初认为的更多的时间,尤其是在用户界面中任务发生得如此之快的情况下,并在承诺自动化看似简单的任务之前做好功课。我早已知晓这一点,但我仍然遇到了一两个障碍,导致项目几乎耗费了我一周的几乎不间断的编码和测试周期。它也提醒了我,如果你认为刷牙和使用牙线需要48个步骤是夸张的,那么你从来没有彻底记录过一个程序。

历史

2016年7月12日,使用一个更健壮的资源生成器宏更新了工作簿,该宏可以优雅地处理其中TEXTINCLUDE标记行已删除其尾部空格的资源脚本。

2016年7月10日,使用了一个已修复的版本更新了工作簿,其中起始资源ID单元格是未受保护的,与其浅绿色背景色一致,并将工作表和VBA项目密码作为文档属性的注释添加,以便在您使用工作簿时始终可以轻松访问它们。文章中唯一的变化是增加了被忽略的关于工作表和VBA项目保护密码的安全措施部分。

2016年6月27日,恢复了在提交过程中损坏的图像链接。

2016年6月25日,我将这篇文章发布给了CP编辑。

© . All rights reserved.