vba - 在保留数字签名的同时复印纸张

Question

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

(注意:在准备本文和测试解决方案的过程中，我可能已经回答了我自己的问题。只是发布此文章是希望任何比我聪明的人都能提出一些建议。无论如何，我认为它仍然是将来搜索者的好资源。)

问题描述

我为其中一个拥有大量VBA的客户制作了一个Excel解决方案。因此，我自然而然地签署了VBA代码，因此我的客户没有收到宏安全性消息。但是，此解决方案要做的一件事是在同一工作簿中复制模板工作表。模板工作表位于其代号上，并且此后将通过其代码名(具有尾随序列nr。)来识别工作表的所有副本-需要对其进行标识并稍后再进行处理。

一见钟情，但是当我演示解决方案并尝试保存它时，我立即得到:

"You have modified a signed project. You do not have the correct key to sign this project. The signature will be discarded."

之后，签名将被丢弃，并在重新打开宏时安全提示充分利用了它们。不好的印象:(

代码如下所示:

工作簿中有一个(隐藏的)"template"工作表，可作为新工作表的来源(它后面没有VBA代码，也没有任何ActiveX或表单控件)；

一个功能区按钮调用VBA代码，该代码使用Worksheet.Copy制作此工作表的副本(并修改该工作表，但此处无关紧要)。

在下一次保存时，Excel要放弃数字签名。

当我在没有证书的计算机上手动执行相同的操作时，会获得相同的体验。 (一课:在演示任何东西之前，请始终在真正空白的系统上进行测试...)

可能的原因

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

尽管模板表上没有“真实的” VBA代码，但VBA模块确实存在，并且包含一些无关紧要的内容。

复制此工作表将创建一个新的工作表，其中包含一个看似“空”但仍存在的VBA模块；

“总” VBA项目的哈希值因此被更改，并且签名丢失。

根据 ozgrid.com上的帖子，这在删除工作表时也会发生，上面已对此进行了解释。它还建议在未打开VBA IDE的情况下创建新表不会触发此操作，删除这些新表也可以。但是一旦您转到VBA IDE，当前存在的所有工作表将再次变为“不可删除”。

我怀疑在没有打开VBA编辑器的情况下添加新工作表时，Excel会添加一个工作表，而实际上没有添加VBA模块，因此项目哈希将不会更新。因此，出于相同的原因，也可以删除这些工作表。依次打开VBA编辑器，使IDE查询工作簿中的模块，这时将创建仍缺少的模块，将它们的存在烘焙到哈希中，这又使它们不可复制，因为它们的VBA占用量已变为非零。 。

解决方案

现在，100万美元的问题是:我们如何解决这个问题？这个站点上有一些聪明人，所以也许我们可以提出一个开箱即用的解决方案？

一个使用细节，这将使这一切变得容易(至少对我而言):客户是唯一一个添加工作表的人，他永远也不会进入IDE。但是，如果我不会因为忘记进入IDE而无意中弄乱了构建，那将是很好的。

我已经尝试了几种可能的解决方案，使用我的签名在计算机上创建它们，然后在没有我的签名的计算机上对其进行测试。目前，我仅将Excel 2010 32位用于这些测试，因为这既是我所拥有的，也是我和我的客户最感兴趣的版本。

非解决方案1

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

如果只是这么简单……这是行不通的，那么模块本身和/或元数据(如其名称)的存在也可能会被散列，这听起来并不合理。否则，您就无法删除所有VBA代码，因为IDE总是会总是添加一个空行(因此，一个CrLf就像您可以这样使它一样空，尽管它的 CodeModule.CountOfLines返回0)。或检索整个VBA代码模块的内容并对其进行哈希处理，以使终止NULL char或前导0字节计数有助于哈希处理。无论如何，这里没有运气。

作为测试，我添加了一个宏，该宏可以告诉您有哪些VBA模块以及它们包含多少行。使用此功能，“已清空”模板工作表的直接副本仍然有0行但签名丢失，而新插入的工作表显示在VBModules集合中，甚至有2行(默认为 Option Explicit)，并且签名仍然粘贴在救...

但是Excel可能只是对我们不利，因为两行的 Option Explicit是虚拟的，甚至VBA模块的存在都是虚拟的。当我使宏也列出所有带有代码名称的工作表时，事实证明这些“安全”工作表的代码名称为空(长度为0的字符串)，实际上表明它们根本没有代码模块。

非解决方案2

而是创建一个新的新表，并且仅复制模板表的内容。

尽管这确实有效，但对我来说似乎有点不高兴。我不相信仅 sourceSheet.Cells.Copy destSheet.Cells就能绝对复制 ，用户可以在上面扔出的所有 ...我宁愿因此继续使用内置的 Worksheet.Copy函数来确保安全，而不必为每个函数编写大量特殊代码可能的细节。

举例来说: sourceSheet.Cells.Copy destSheet.Cells例如确实会复制工作表特定的命名范围，但显然仅在工作表本身上实际使用了它们的情况下。未引用的名称将在副本中消失!谈论我必须编写的特殊情况下的复制代码...

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

非解决方案3

创建一个新的临时工作簿，在工作表上用 Worksheet.Copy编码，记下它的名称，将其明确保存为.xlsx文件以摆脱任何VBA模块，关闭并重新打开temp工作簿以摆脱任何旧的内存碎片，再按名称找到它，然后使用 Worksheet.Move将其返回源工作簿。

这可行!如果没有重新打开实际的工作簿，它就不会被打开，因此我猜想内存中的表示形式就不能轻易被“擦除”，不会造成任何伤害。

但是... 新工作表再次完全没有得到代码名称，甚至更多:我不喜欢此工作表移至无关的工作簿；它不适合任何工作。在进行快速测试时，保留了原始工作簿中对其他工作表的任何引用(甚至没有扩展为包括工作簿名称或路径!)，对此我仍然有些不安...谁知道哪种类型的内容用户可能会扔给它...

谁知道那里有什么类型的机密信息，我不想对这些机密信息最终从Temp文件夹中泄漏而无知。

非解决方案4

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

我只是无法设计出一种方法来做到这一点。 VBA本身似乎不允许您这样做，然后再一次，我不希望我的客户仅为此启用“允许访问VB项目”选项。而且我怀疑如果我能够做到这一点，那么在我无法再次对代码模块进行核对之前，损害就已经完成了。

非解决方案5

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

解决方案2的注意事项在这里不那么重要，因为我知道自己在进行新版本交付时模板表上的内容，因此，完美复制所需的代码量最少，并且可以控制。但是3似乎更安全，更容易...我必须选择一个。

由于我仅通过直接使用 shtTemplate.而不是 ThisWorkbook.Worksheets("Template").来访问其VBA代码名称上的模板工作表，这显然使Excel变得非常复杂，以至于无法即时切换它。到目前为止，我所有的尝试都失败了，或者使Excel崩溃了。那里没有爱:(

我通过操作加载到第二个设置为 msoAutomationSecurityForceDisable的Excel中的副本来再次尝试此操作，从而避免破坏正在运行的VBA主机，并且几乎每次更新后都保存并重新打开。但这无济于事，在打开已清理的工作簿时出现诸如“自动化错误-灾难性故障”之类的错误，或者极大破坏了新工作簿(为项目浏览器中的每个工作表模块使用派生名称复制了 ThisWorkbook模块)。

也许解决方案6

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

该代码终于可以工作了，甚至不必使用第二个登台Excel。没有崩溃也没有腐败!但是，此代码仅在无法终身使用的代码范围内有效，该代码无法再次为擦洗纸赋予有效的代码名称。它仍然是零长度的字符串。而且也没有运行时错误表明这一点。在此期间打开IDE时，虽然代码名称设置正确。

这使我相信，在工作表上有一个代码名称意味着它具有一个非空的代码模块，这意味着它与数字签名混淆了。事后看来，这真的不是那么意外。

最终解决方案

这使我相信，创建模板表既不可能，又没有办法:

可通过Worksheet.Copy安全复制而不会丢失签名和

具有非空的代码名称时，没有代码模块。

因此，到目前为止，我唯一看到的解决方案是确实使用清理后的模板工作表来使用 Worksheet.Copy，但是通过其他方式(而不是通过其代码名)找到并识别它，并生成工作表。尽管可以使我内心的完美主义者感到畏缩，但上面有一个用户隐藏的部分，我可能会添加“这是模板/副本”状态。

但是，如果有人喜欢尝试，那么有更多其他选择会很好!我可以在需要时发布代码示例。

Answer 1

需要付出很多，我不假装这会回答将解决您所有的问题。但是我曾经写过一个名为SoftLink的函数，该函数最多包含4个参数(i) bool(boolean) 值:CellRef(或NamedRange)(ii)字符串:范围(iii)字符串:WorksheetName(iv)字符串:WorkbookName，它将断开与任何链接的链接单元格，然后解析VBA代码中的字符串参数。

毫无疑问，这种方法会降低性能，但这是解决Link hell的一种方法。

调用公式示例

=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