在保留数字签名的同时复制工作表

Question

- 编辑：现在这是此问题上下文中bigger question of how to reliably move sheets about的一部分 -

（注意：在准备这篇文章和测试解决方案时，我可能已经回答了我自己的问题。只是发布这个，希望任何比我更聪明的人能想出一些东西。无论如何，它仍然是一个很好的资源。对于未来的搜索者我猜。）

问题描述

我为我的一个客户制作了一个Excel解决方案，里面有大量的VBA。因此，我自然签署了VBA代码，因此我的客户没有获得宏安全消息。但是，此解决方案的一个功能是在同一工作簿中制作模板工作表的副本。在它的代码名称上找到模板表，并且从那时开始通过它们的代码名称识别该表单的所有副本（具有尾随序列nr。） - 它们需要在以后识别和处理再次。

第一眼看上去很无辜，但当我演示解决方案并试图保存它时，我立刻得到了：

  

＆＃34;您修改了已签名的项目。您没有正确的密钥   签署这个项目。签名将被丢弃。＆＃34;

之后签名被丢弃，并在重新打开宏安全提示时自行充分利用。不是一个好印象:(

代码以简化形式出现：

1. 有一个（隐藏的）＆＃34;模板＆＃34;工作簿中的工作表作为新工作表的源（它后面没有VBA代码，也没有任何ActiveX或表单控件）;
2. 功能区按钮调用VBA代码，该代码使用Worksheet.Copy制作此工作表的副本（并修改副本，但这与此无关）;
3. 在下次保存时，Excel想要丢弃数字签名。

当我在没有证书的机器上手动执行相同操作时，我获得相同的体验。 （一课：在演示任何东西之前，总是在真正的空白系统上进行测试......）

可能的原因

我已经对此进行了一些搜索（例如ozgrid.com和answers.microsoft.com），虽然很少有人遇到这种情况，但这似乎是一种不可避免的事情。其背后的原因我怀疑是这样的：

1. 虽然模板表没有真正的＆＃39; VBA代码就确实存在，VBA模块确实存在并且有一些不重要的内容;
2. 复制此工作表会创建一个新工作表，其中看起来似乎是空的＆＃39;但仍然存在且因此重要的VBA模块;
3. ＆＃39;总计＆＃39;因此，VBA项目被改变，签名丢失。

根据ozgrid.com上的帖子，这也发生在删除工作表上，如上所述。它还建议在没有打开VBA IDE的情况下创建新工作表不会触发此工作，并且删除这些新工作表也可以。但是一旦你进入VBA IDE，目前存在的所有工作表都变得“不可删除”。试。

我怀疑当你在没有打开VBA编辑器的情况下添加新工作表时，Excel会添加一个真正没有添加VBA模块的工作表，因此项目哈希不会更新。因此，出于同样的原因也可以删除这些纸张。反过来打开VBA编辑器会对工作簿中的模块进行IDE查询，此时这些仍然缺失的模块被创建，将它们的存在加入到哈希中，这反过来又使它们不可复制，因为它们的VBA占用空间已变为非零

解决方案

现在$ 1,000,000的问题是：我们如何解决这个问题？这个网站上有一些聪明人，所以也许我们可以提出一个开箱即用的解决方案？

一个可以使这更容易的用法细节（至少对我而言）：客户是唯一一个添加工作表的人，他永远不会进入IDE。如果我只是忘记进入IDE而无意中弄乱了构建，那将是很好的。

我已经尝试了几种可能的解决方案，在我的签名计算机上创建它们，并在没有我签名的计算机上测试它们。目前我只使用Excel 2010 32位专门用于这些测试，因为这是我所拥有的，而且它也是我和我的客户最感兴趣的版本。

非解决方案1 ​​

通过IDE从模板表中删除所有VBA代码，因此它对哈希没有贡献。

如果只是这么简单......这没有用，所以模块本身和/或它的元数据（比如它的名字）的存在也可能也是如此哈希，听起来不合理。或者你根本无法删除所有的VBA代码，因为IDE总是会附加一个空行（所以单个CrLf是空的，因为你可以这样做，尽管它的CodeModule.CountOfLines返回0它）。或者检索并散列整个VBA代码模块的内容，使得终止NULL char或前导0字节计数对散列有贡献。无论如何，这里没有运气。

作为测试，我添加了一个宏，告诉它有哪些VBA模块，以及它们包含多少行。使用这个，直接复制＆＃39;清空＆＃39;模板工作表仍然有0行，但签名丢失，而新插入的工作表显示在VBModules集合中，甚至有2行（默认Option Explicit），签名仍然保存...

但Excel可能只是让我们高兴，因为2行Option Explicit是虚拟的，甚至VBA模块的存在首先是虚拟的。当我制作宏时，还列出了所有带有代码名称的工作表，结果发现这些安全＆＃39;工作表有一个空代码名称（0长度字符串），确实表明它们根本没有代码模块。

非解决方案2

改为创建一个全新的工作表，只复制模板工作表的内容。

虽然这确实有效，但对我来说似乎有些不确定;我不相信仅仅sourceSheet.Cells.Copy destSheet.Cells会复制用户可以使用它的绝对一切 ...我宁愿继续使用内置Worksheet.Copy功能为了安全而不必为每一个可以想象的细节编写成堆的特殊代码。

作为一个例子：sourceSheet.Cells.Copy destSheet.Cells，例如复制工作表特定的命名范围，但显然只有它们实际上在工作表本身上使用。未引用的名字在副本中消失了！谈论特殊情况下的复制代码我必须写...

然后复制的表单根本没有分配任何代码名称，我目前需要识别它们。

非解决方案3

创建一个新的临时工作簿，Worksheet.Copy工作表，记下它的名称，显式保存为.xlsx文件以删除任何VBA模块，关闭并重新打开temp工作簿摆脱任何旧的记忆中的残骸，再按名称找到它，然后Worksheet.Move它回到源工作簿。

这个有效！如果没有实际的工作簿重新打开它就不会，所以我想内存中的表示不能被擦除＆＃39;很容易就不会造成任何伤害。

然而...... 新的表单根本没有得到代码名称，甚至更多：我不喜欢这张表转向不相关的工作簿;而在快速测试中，对原始工作簿中其他工作表的任何引用都得到了保护（甚至没有扩展到包含工作簿名称或路径！），我对此仍然有点不安......谁知道用户的内容类型可能会抛出它......

＆lt; Paranoid mode =＆＃34; on＆＃34;＆gt;谁知道那里会有什么类型的机密信息，我不想让它在最终从Temp文件夹泄漏时负责他们不知道。＆lt; / Paranoid＆gt;

非解决方案4

创建一个新的空的临时工作表以及模板的Worksheet.Copy，然后用临时工作表替换真实副本的VBA模块。或者只是整个VBA模块。

我无法设法实现这一目标。 VBA本身似乎不会让你这样做，然后我又不希望我的客户必须打开“允许访问VB项目＆＃39;仅此选项。而且我怀疑我是否能够做到这一点，在我再次修改代码模块之前已经完成了损坏。

非解决方案5

创建一个仅对我（开发人员）可见的宏，它通过解决方案2或3创建模板表的完美副本，并丢弃原始模板表，将其替换为VBA擦除副本。在将其交付给客户之前，我将被用作最后一步。

解决方案2的注意事项在这里不太重要，因为我确实知道自己在制作新版本时模板上的内容，因此完美复制所需的代码量很少，而且可以受到控制。但是，3似乎更安全，更容易......我必须选择一个。

由于我直接使用shtTemplate.而不是ThisWorkbook.Worksheets("Template").来访问其上的模板表，这显然使Excel复杂化，以便将其切换为 - 和 - 飞行中。到目前为止，我所有的尝试都失败了，或者只是让Excel崩溃了。没有爱在那里:(

我通过将第二个Excel集中加载的副本设置为msoAutomationSecurityForceDisable来再次尝试此操作，从而避免运行的VBA主机被破坏，几乎每次更新后都会保存并重新打开。但这也没有任何结果，给出了错误，例如＆＃34;自动化错误 - 灾难性失败＆＃34;打开已清理的工作簿时，或者严重损坏新工作簿（项目资源管理器中每个工作表模块的ThisWorkbook模块都带有派生名称）。

可能 - 解决方案6

重新编写所有VBA以不使用硬编码模板表的代码名称，但将此名称存储在设置表中，然后应用上面的解决方案5.

代码最终有效，甚至不必使用第二个登台Excel;没有崩溃也没有腐败！但是这段代码只能在我的生活中无法获得代码，以便再次为擦洗表提供有效的代码名称;它仍然是一个零长度的字符串。并且没有运行时错误来指示这一点。当我在此期间打开IDE时，代码名称已正确设置。

这让我相信在工作表上有一个代码名称意味着它有一个非空代码模块，这意味着它会弄乱数字签名。事后来看，这真的不是那么出乎意料。

最终解决方案

这让我相信我无法创建两个模板表：

1. 可以安全地通过Worksheet.Copy复制而不会丢失签名，
2. 具有非空代码名称时没有代码模块。

到目前为止，我看到的唯一解决方案是确实使用擦洗模板表来使用Worksheet.Copy，但是通过其他方式查找和识别它以及它的结果表代码名称。有一个用户隐藏的部分，我可以添加一个＆＃34;这是模板/副本＆＃34;虽然它让我内在的完美主义者感到畏缩，但是地位却很高。

然而，如果有人想要尝试，那么有更多选择会更好！我可以在需要时发布代码示例。

Answer 1

要吸收很多东西，而且我不会预先知道这个答案会解决你所有的问题。但是我曾经写过一个名为SoftLink的函数，它最多需要4个参数（i）布尔值：CellRef（或NamedRange）（ii）字符串：范围（iii）字符串：WorksheetName（iv）字符串：工作簿名称会破坏任何链接单元格然后解析VBA代码中的字符串参数。

毫无疑问，这种方法会影响性能，但它是解决Link地狱的一种方法。

调用公式的示例

=softlink(FALSE,"Foo")
=softlink(TRUE,"C4","Sheet1","Book2")
=softlink(TRUE,"D5","Sheet2")

我从内存中剔除了一个实现。我有一个On Errors的恐惧症......所以请原谅子程序中的一些奇怪的循环。

Option Explicit

Function SoftLink(ByVal bIsCell As Boolean, ByVal sRangeName As String, _
                    Optional sSheetName As String, Optional sBookName As String) As Variant

    Dim vRet As Variant
    If Len(sRangeName) = 0 Then vRet = "#Cannot resolve null range name!": GoTo SingleExit '* fast fail


    Dim rngCaller As Excel.Range
    Set rngCaller = Application.Caller

    Dim wsCaller As Excel.Worksheet
    Set wsCaller = rngCaller.Parent

    Dim wbCaller As Excel.Workbook
    Set wbCaller = wsCaller.Parent

    Dim wb As Excel.Workbook

    If Len(sBookName) > 0 Then
        vRet = FindWorkbookWithoutOnErrorResumeNext(sBookName, wb)
        If Len(vRet) > 0 Then GoTo ErrorMessageExit
    Else
        Set wb = wbCaller
    End If
    Debug.Assert Not wb Is Nothing
    Dim ws As Excel.Worksheet
    If Len(sSheetName) > 0 Then
        vRet = FindWorksheetWithoutOnErrorResumeNext(wb, sSheetName, ws)
        If Len(vRet) > 0 Then GoTo ErrorMessageExit

    Else
        Set ws = wsCaller
    End If

    Dim rng As Excel.Range
    If bIsCell Then
        vRet = AcquireCellRange(ws, sRangeName, rng)
        If Len(vRet) > 0 Then GoTo ErrorMessageExit
    Else
        vRet = AcquireNamedRangeWithoutOERN(ws, sRangeName, rng)
        If Len(vRet) > 0 Then GoTo ErrorMessageExit
    End If

    SoftLink = rng.Value2
SingleExit:
    Exit Function
ErrorMessageExit:
    SoftLink = vRet
    GoTo SingleExit
End Function

Function AcquireCellRange(ByVal ws As Excel.Worksheet, ByVal sRangeName As String, ByRef prng As Excel.Range) As String

    On Error GoTo FailedCellRef
    Set prng = ws.Range(sRangeName)

SingleExit:
    Exit Function
FailedCellRef:
    AcquireCellRange = "#Could not resolve range name '" & sRangeName & "' on worksheet name '" & ws.Name & "' in workbook '" & ws.Parent.Name & "'!"

End Function


Function AcquireNamedRangeWithoutOERN(ByVal ws As Excel.Worksheet, ByVal sRangeName As String, ByRef prng As Excel.Range) As String

    '* because I do not like OERN
    Dim oNames As Excel.Names

    Dim bSheetScope As Long
    For bSheetScope = True To False

        Set oNames = VBA.IIf(bSheetScope, ws.Names, ws.Parent.Names)

        Dim namLoop As Excel.Name
        For Each namLoop In oNames
            If VBA.StrComp(namLoop.Name, sRangeName, vbTextCompare) = 0 Then

                Set prng = ws.Range(sRangeName)
                GoTo SingleExit
            End If

        Next
    Next

ErrorMessageExit:
    AcquireNamedRangeWithoutOERN = "#Could not resolve range name '" & sRangeName & "' on worksheet name '" & ws.Name & "' in workbook '" & ws.Parent.Name & "'!"
SingleExit:
    Exit Function

End Function

Function FindWorksheetWithoutOnErrorResumeNext(ByVal wb As Excel.Workbook, ByVal sSheetName As String, ByRef pws As Excel.Worksheet) As String
    '* because I do not like OERN
    Dim wsLoop As Excel.Worksheet
    For Each wsLoop In wb.Worksheets
        If VBA.StrComp(wsLoop.Name, sSheetName, vbTextCompare) = 0 Then
            Set pws = wsLoop

            GoTo SingleExit
        End If

    Next wsLoop
ErrorMessageExit:
    FindWorksheetWithoutOnErrorResumeNext = "#Could not resolve worksheet name '" & sSheetName & "' in workbook '" & wb.Name & "'!"
SingleExit:
    Exit Function
End Function


Function FindWorkbookWithoutOnErrorResumeNext(ByVal sBookName As String, ByRef pwb As Excel.Workbook) As String
    '* because I do not like OERN
    Dim wbLoop As Excel.Workbook
    For Each wbLoop In Application.Workbooks
        If VBA.StrComp(wbLoop.Name, sBookName, vbTextCompare) = 0 Then
            Set pwb = wbLoop

            GoTo SingleExit
        End If

    Next wbLoop
ErrorMessageExit:
    FindWorkbookWithoutOnErrorResumeNext = "#Could not resolve workbook name '" & sBookName & "'!"
SingleExit:
    Exit Function
End Function