保护Excel工作表-不可能？

我正在尝试共享Excel工作簿，但只能访问几个可见的工作表。由于Excel的安全漏洞和工作表的密码保护，这比最初预期的要困难得多

我的问题是由于一些隐藏的工作表需要保持隐藏，并且内容无法访问，但是如果结果显示在可见的工作表中，则需要进行计算

到目前为止，我已尝试在VBA窗口中“超级隐藏”图纸并锁定VBA项目。这样做的目的是，如果没有VBA项目密码，用户就无法取消隐藏“超级隐藏”表。 我曾尝试添加额外的VBA代码来对付某些“攻击”，但我不断地返回到一个已知的缺陷，它绕过了我的所有努力：

步骤1： 保存或确保Excel工作簿保存为.xlsx或.xlsm

步骤2： 从其他工作簿或personal.xlsb中运行以下代码，从工作表和结构保护中删除密码 （我本可以链接到我找到代码的帖子，但我现在找不到…）

工作簿现在已清除了工作表上的密码和结构保护，通过将工作簿保存为.xlsx文件，任何“计数器”VBA代码都将消失

我曾考虑添加一个用户定义的函数，用于检查工作簿文件的扩展名是否为“.xlsb”。如果扩展名为“.xlsb”，则函数将返回“1”，然后将其乘以重要的值。如果工作簿另存为其他内容，或者如果VBA项目完全删除为另存为.xlsx，则这将导致计算失败。 然而，我不喜欢这种方法，因为我不认为这是一个长期的解决方案

因此，我的问题是：

---

有没有一种方法可以安全地共享一个Excel工作簿，只访问几张工作表，而不危及用户可以访问隐藏的工作表和/或不需要的内容？

在VBE中，您可以将特定工作表的

Visible

属性更改为

xlSheetVeryHidden

这会将其从前端完全拆下

然后，可以添加密码来保护VBE中的VBA项目，以防止用户更改该属性（如果他们知道）

此外，您仍可以使用VBA代码访问这些图纸

编辑：

我还向上面添加了一个特定工作表的密码，这是正常的。但是，如果必须取消隐藏，

Worksheet\u Activate

事件也会触发自定义

UserForm

的

UserForm

。如果他们输入了错误的密码或关闭

UserForm

，工作表将再次隐藏。您可以向此事件处理程序添加各种类型，例如重新保护工作表、重新保护项目、使用加密密码保护工作簿以及作为安全“漏洞”关闭工作簿

---

可能性是无穷的。这不是一个确切的预防措施，但希望这能有所帮助

我想问题的第三段解释了他已经这么做了。@VincentG我也补充了一些。感谢您指出。嗨，Dean，我也尝试过这个方法，但在将文件保存为.xlsx（使用计数器代码删除到VBA项目）方面失败了。如果您将工作簿保存为.xlsx文件并运行步骤2和3，您的工作表将可见且不受密码保护，并且您的VBA将消失……好了，没有完全安全的方法来保护excel工作簿/工作表。一种方法是对数据进行编码，这样即使内容未被隐藏，在没有解码功能的情况下也无法使用。嗨，Vincent G，有趣的想法-你打算怎么做？就像excel中的SHA256函数一样？我认为这个问题的一般结论是，您永远不能假设excel是安全的。这也是我到目前为止得出的结论——遗憾的是。。。。

Sub RemoveProtection()

Dim dialogBox As FileDialog
Dim sourceFullName As String
Dim sourceFilePath As String
Dim SourceFileName As String
Dim sourceFileType As String
Dim newFileName As Variant
Dim tempFileName As String
Dim zipFilePath As Variant
Dim oApp As Object
Dim FSO As Object
Dim xmlSheetFile As String
Dim xmlFile As Integer
Dim xmlFileContent As String
Dim xmlStartProtectionCode As Double
Dim xmlEndProtectionCode As Double
Dim xmlProtectionString As String

'Open dialog box to select a file
Set dialogBox = Application.FileDialog(msoFileDialogFilePicker)
dialogBox.AllowMultiSelect = False
dialogBox.Title = "Select file to remove protection from"

If dialogBox.show = -1 Then
    sourceFullName = dialogBox.SelectedItems(1)
Else
    Exit Sub
End If

'Get folder path, file type and file name from the sourceFullName
sourceFilePath = Left(sourceFullName, InStrRev(sourceFullName, "\"))
sourceFileType = Mid(sourceFullName, InStrRev(sourceFullName, ".") + 1)
SourceFileName = Mid(sourceFullName, Len(sourceFilePath) + 1)
SourceFileName = Left(SourceFileName, InStrRev(SourceFileName, ".") - 1)

'Use the date and time to create a unique file name
tempFileName = "Temp" & Format(Now, " dd-mmm-yy h-mm-ss")

'Copy and rename original file to a zip file with a unique name
newFileName = sourceFilePath & tempFileName & ".zip"
On Error Resume Next
FileCopy sourceFullName, newFileName

If Err.Number <> 0 Then
    MsgBox "Unable to copy " & sourceFullName & vbNewLine _
        & "Check the file is closed and try again"
    Exit Sub
End If
On Error GoTo 0

'Create folder to unzip to
zipFilePath = sourceFilePath & tempFileName & "\"
MkDir zipFilePath

'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(zipFilePath).CopyHere oApp.Namespace(newFileName).Items

'loop through each file in the \xl\worksheets folder of the unzipped file
xmlSheetFile = Dir(zipFilePath & "\xl\worksheets\*.xml*")
Do While xmlSheetFile <> ""

    'Read text of the file to a variable
    xmlFile = FreeFile
    Open zipFilePath & "xl\worksheets\" & xmlSheetFile For Input As xmlFile
    xmlFileContent = Input(LOF(xmlFile), xmlFile)
    Close xmlFile

    'Manipulate the text in the file
    xmlStartProtectionCode = 0
    xmlStartProtectionCode = InStr(1, xmlFileContent, "<sheetProtection")

    If xmlStartProtectionCode > 0 Then

        xmlEndProtectionCode = InStr(xmlStartProtectionCode, _
            xmlFileContent, "/>") + 2 '"/>" is 2 characters long
        xmlProtectionString = Mid(xmlFileContent, xmlStartProtectionCode, _
            xmlEndProtectionCode - xmlStartProtectionCode)
        xmlFileContent = Replace(xmlFileContent, xmlProtectionString, "")

    End If

    'Output the text of the variable to the file
    xmlFile = FreeFile
    Open zipFilePath & "xl\worksheets\" & xmlSheetFile For Output As xmlFile
    Print #xmlFile, xmlFileContent
    Close xmlFile

    'Loop to next xmlFile in directory
    xmlSheetFile = Dir

Loop

'Read text of the xl\workbook.xml file to a variable
xmlFile = FreeFile
Open zipFilePath & "xl\workbook.xml" For Input As xmlFile
xmlFileContent = Input(LOF(xmlFile), xmlFile)
Close xmlFile

'Manipulate the text in the file to remove the workbook protection
xmlStartProtectionCode = 0
xmlStartProtectionCode = InStr(1, xmlFileContent, "<workbookProtection")
If xmlStartProtectionCode > 0 Then

    xmlEndProtectionCode = InStr(xmlStartProtectionCode, _
        xmlFileContent, "/>") + 2 ''"/>" is 2 characters long
    xmlProtectionString = Mid(xmlFileContent, xmlStartProtectionCode, _
        xmlEndProtectionCode - xmlStartProtectionCode)
    xmlFileContent = Replace(xmlFileContent, xmlProtectionString, "")

End If

'Manipulate the text in the file to remove the modify password
xmlStartProtectionCode = 0
xmlStartProtectionCode = InStr(1, xmlFileContent, "<fileSharing")
If xmlStartProtectionCode > 0 Then

    xmlEndProtectionCode = InStr(xmlStartProtectionCode, xmlFileContent, _
        "/>") + 2 ''"/>" is 2 characters long
    xmlProtectionString = Mid(xmlFileContent, xmlStartProtectionCode, _
        xmlEndProtectionCode - xmlStartProtectionCode)
    xmlFileContent = Replace(xmlFileContent, xmlProtectionString, "")

End If

'Output the text of the variable to the file
xmlFile = FreeFile
Open zipFilePath & "xl\workbook.xml" & xmlSheetFile For Output As xmlFile
Print #xmlFile, xmlFileContent
Close xmlFile

'Create empty Zip File
Open sourceFilePath & tempFileName & ".zip" For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1

'Move files into the zip file
oApp.Namespace(sourceFilePath & tempFileName & ".zip").CopyHere _
oApp.Namespace(zipFilePath).Items
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(sourceFilePath & tempFileName & ".zip").Items.count = _
    oApp.Namespace(zipFilePath).Items.count
    Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0

'Delete the files & folders created during the sub
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder sourceFilePath & tempFileName

'Rename the final file back to an xlsx file
Name sourceFilePath & tempFileName & ".zip" As sourceFilePath & SourceFileName _
& "_" & Format(Now, "dd-mmm-yy h-mm-ss") & "." & sourceFileType

'Show message box
MsgBox "The workbook and worksheet protection passwords have been removed.", _
vbInformation + vbOKOnly, Title:="Password protection"

End Sub

Sub UnhideAllSheets()

For Each Worksheet In ActiveWorkbook.Sheets
        Worksheet.Visible = -1
Next Worksheet

End Sub