Vba 防止工作簿保存但保存在宏中

我正在编写一个代码，该代码将阻止用户保存工作簿，并且它将仅在我需要时保存。这是为了防止用户在不应该进行更改和保存时进行更改和保存。我已经创建了两个私有sub，但我不知道如何在自己保存工作簿时进行例外。我希望能够将保存代码放在各种宏中，这样我就可以随时控制保存

以下是我的代码：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    MsgBox "You can't save this workbook!"
    Cancel = True

End Sub

Private Sub Workbook_Open()
Dim myValue As String
Dim Answer As String
Dim MyNote As String

MsgBox "Welcome to the Lot Input Program"
If Range("A1").Value = "" Then
Line:
    myValue = InputBox("Please input your email address:", "Input", "x@us.tel.com")
    'Place your text here
    MyNote = "Is this correct?: " & myValue
    'Display MessageBox
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Confirmation")
    If Answer = vbNo Then
        'Code for No button Press
        GoTo Line
    Else
        Range("A1").Value = myValue
    End If
    ActiveWorkbook.Save
End If
End Sub

---

你可以试试这样的

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Environ("UserName") <> "YourUserNameHere" Then
    MsgBox "You can't save this workbook!"
    Cancel = True
End If
End Sub

---

我添加了一个公共变量saveLock，我在savecancel代码中引用了它。这允许我锁定和解锁代码内部的保存。如果有人有更好的方法，请让我知道，但这确实解决了问题

Public saveLock As Integer
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If saveLock = 0 Then
    Cancel = True
End If
End Sub
Private Sub Workbook_Open()
Dim myValue As String
Dim Answer As String
Dim MyNote As String
saveLock = 0

MsgBox "Welcome to the Lot Input Program"
If Range("A1").Value = "" Then
Line:
    myValue = InputBox("Please input your email address:", "Input", "x@us.tel.com")
    'Place your text here
    MyNote = "Is this correct?: " & myValue
    'Display MessageBox
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Confirmation")
    If Answer = vbNo Then
        'Code for No button Press
        GoTo Line
    Else
        Range("A1").Value = myValue
    End If
    saveLock = 1
    ActiveWorkbook.Save
    saveLock = 0
End If
End Sub

---

您可以检查

Environ$（“用户名”）

以查看谁打开了它。这将返回他们用来登录计算机的用户名。我遇到的问题是，我将把它分发给办公室里的每个人，所以我无法将用户名硬编码到这个文件中。此外，在这种情况下，用户名是不相关的，因为当我在整个项目中使用保存功能时，无论用户是谁，它都需要能够保存，因此没有任何东西可以限制我对用户强制进行的保存。代码将阻止所有其他用户保存文件，除非您在自己的系统上打开文件并保存。另一个解决方法是，您可以使用带有一个文本框的UserForm来接受要保存的密码，当有人试图保存文件时，会弹出UserForm，要求用户输入密码，如果输入的密码正确，则允许用户现在将文件保存到其他位置。使用UserForm的优点是，您可以使用InputBox无法使用的密码字符隐藏输入的密码。问题是，我仍然希望能够在“未授权”人员的计算机上启动保存。例如，虽然我可能会使用密码限制保存，但我仍然希望在运行的某些时间点保存他们的文件。是否可以对保存设置密码限制，然后在运行代码时自动输入密码？当触发保存时，代码永远不知道是谁触发了它，并且无法决定是否允许保存。因此，如果您试图将文件保存到另一个用户的系统上，则只需告诉代码是您触发了保存并显式提供密码。虽然您可以在msgbox弹出并告诉用户“您无法保存此工作簿！”后调用UserForm，其中有一行“您是否有保存文件的密码？有关代码，请参阅编辑后的答案…”。。。

Public saveLock As Integer
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If saveLock = 0 Then
    Cancel = True
End If
End Sub
Private Sub Workbook_Open()
Dim myValue As String
Dim Answer As String
Dim MyNote As String
saveLock = 0

MsgBox "Welcome to the Lot Input Program"
If Range("A1").Value = "" Then
Line:
    myValue = InputBox("Please input your email address:", "Input", "x@us.tel.com")
    'Place your text here
    MyNote = "Is this correct?: " & myValue
    'Display MessageBox
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Confirmation")
    If Answer = vbNo Then
        'Code for No button Press
        GoTo Line
    Else
        Range("A1").Value = myValue
    End If
    saveLock = 1
    ActiveWorkbook.Save
    saveLock = 0
End If
End Sub