Excel 宏不'；当板材受到保护时，不得工作。运行宏返回运行时错误1004

我的工作簿中有三个宏可以正常工作。但是，当我保护任何工作表时，它们停止工作，我得到一个

运行时错误1004

我在网上找到了以下两条建议：

• 在宏代码开始时取消保护，在结束时进行保护
• 但运行时错误仍然存在

我需要保护我的工作簿，为了使宏正常工作，我该怎么做

宏1:

Sub Macro1()

Dim historyWks As Worksheet
Dim inputWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myCopy As Range
Dim myTest As Range

Dim lRsp As Long

Set inputWks = Worksheets("Visit & Order Entry Form")
Set historyWks = Worksheets("Visit & Order Database")

'check for duplicate order ID in database
If inputWks.Range("CheckID2") = True Then
  lRsp = MsgBox("Clinic ID already in database. Update database?", vbQuestion + vbYesNo, "Duplicate ID")
  If lRsp = vbYes Then
    UpdateLogRecord
  Else
    MsgBox "Please change Clinic ID to a unique number."
  End If

Else

  'cells to copy from Input sheet - some contain formulas
  Set myCopy = inputWks.Range("OrderEntry2")

  With historyWks
      nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  End With

  With inputWks
      Set myTest = myCopy.Offset(0, 2)

      If Application.Count(myTest) > 0 Then
          MsgBox "Please fill in all the cells!"
          Exit Sub
      End If
  End With

  With historyWks
      With .Cells(nextRow, "A")
          .Value = Now
          .NumberFormat = "mm/dd/yyyy hh:mm:ss"
      End With
      .Cells(nextRow, "B").Value = Application.UserName
      oCol = 3
      myCopy.Copy
      .Cells(nextRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
      Application.CutCopyMode = False
  End With

  'clear input cells that contain constants
  With inputWks
    On Error Resume Next
       With myCopy.Cells.SpecialCells(xlCellTypeConstants)
            .ClearContents
            Application.GoTo .Cells(1) ', Scroll:=True
       End With
    On Error GoTo 0
  End With
End If

End Sub

宏2

Sub UpdateLogWorksheet()

Dim historyWks As Worksheet
Dim inputWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myCopy As Range
Dim myTest As Range

Dim lRsp As Long

Set inputWks = Worksheets("Visit & Order Entry Form")
Set historyWks = Worksheets("Contact Details & Segm Database")

'check for duplicate order ID in database
If inputWks.Range("CheckID") = True Then
  lRsp = MsgBox("Clinic ID already in database. Update database?", vbQuestion + vbYesNo, "Duplicate ID")
  If lRsp = vbYes Then
    UpdateLogRecord
  Else
    MsgBox "Please change Clinic ID to a unique number."
  End If

Else

  'cells to copy from Input sheet - some contain formulas
  Set myCopy = inputWks.Range("OrderEntry")

  With historyWks
      nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  End With

  With inputWks
      Set myTest = myCopy.Offset(0, 2)

      If Application.Count(myTest) > 0 Then
          MsgBox "Please fill in all the cells!"
          Exit Sub
      End If
  End With

  With historyWks
      With .Cells(nextRow, "A")
          .Value = Now
          .NumberFormat = "mm/dd/yyyy hh:mm:ss"
      End With
      .Cells(nextRow, "B").Value = Application.UserName
      oCol = 3
      myCopy.Copy
      .Cells(nextRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
      Application.CutCopyMode = False
  End With

  'clear input cells that contain constants
  With inputWks
    On Error Resume Next
       With myCopy.Cells.SpecialCells(xlCellTypeConstants)
            .ClearContents
            Application.GoTo .Cells(52) ', Scroll:=True
       End With
    On Error GoTo 0
  End With
End If

End Sub

宏3

Sub UpdateLogRecord()

Dim historyWks As Worksheet
Dim inputWks As Worksheet

Dim lRec As Long
Dim oCol As Long
Dim lRecRow As Long

Dim myCopy As Range
Dim myTest As Range

Dim lRsp As Long

Set inputWks = Worksheets("Visit & Order Entry Form")
Set historyWks = Worksheets("Contact Details & Segm Database")

'check for duplicate order ID in database
If inputWks.Range("CheckID") = False Then
  lRsp = MsgBox("Clinic ID not in database. Add clinic to database?", vbQuestion + vbYesNo, "New Order ID")
  If lRsp = vbYes Then
    UpdateLogWorksheet
  Else
    MsgBox "Please select Clinic ID that is in the database."
  End If

Else

  'cells to copy from Input sheet - some contain formulas
  Set myCopy = inputWks.Range("OrderEntry")

  lRec = inputWks.Range("CurrRec").Value
  lRecRow = lRec + 1

  With inputWks
      Set myTest = myCopy.Offset(0, 2)

      If Application.Count(myTest) > 0 Then
          MsgBox "Please fill in all the cells!"
          Exit Sub
      End If
  End With

  With historyWks
      With .Cells(lRecRow, "A")
          .Value = Now
          .NumberFormat = "mm/dd/yyyy hh:mm:ss"
      End With
      .Cells(lRecRow, "B").Value = Application.UserName
      oCol = 3

      myCopy.Copy
      .Cells(lRecRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
      Application.CutCopyMode = False
  End With

  'clear input cells that contain constants
  With inputWks
    On Error Resume Next
       With myCopy.Cells.SpecialCells(xlCellTypeConstants)
            .ClearContents
            Application.GoTo .Cells(52) ', Scroll:=True
       End With
    On Error GoTo 0
  End With
End If

End Sub

---

这里没有任何代码可以在宏开始时取消保护，然后在结束时再次保护。一开始你需要这样的东西（我想你已经知道这一点，但只是想说清楚）

最后：

SheetName.Protect Password:=yourPassword

你说你已经试过了，但是从你发布的代码中不清楚你在哪里有这些命令

我注意到，在试图重现这一行为时，您有两个不同的工作表，称为

historyWks

，这可能会导致锁定和解锁问题

一种选择是在入口点取消对所有工作表的保护，然后在出口处再次对其进行保护

Private Const yourPassword As String = "password"

Sub UnprotectAll()
    Dim sh As Worksheet
    For Each sh In ActiveWorkbook.Worksheets
        sh.Unprotect Password:=yourPassword
    Next sh
End Sub

Sub ProtectAll()
    Dim sh As Worksheet
    For Each sh In ActiveWorkbook.Worksheets
        sh.Protect Password:=yourPassword
    Next sh
End Sub

---

您只需要在

Macro1

的开头和结尾调用这些函数。您可能还希望在开始时添加一个

Application.screenUpdate=False

，以避免它在所有工作表中循环时闪烁，然后在

Macro1

末尾添加

Application.screenUpdate=True

，

宏初学者帮助：

如果使用按钮运行宏， 包括以下内部子按钮单击（）

“现在输入需要运行的宏

，在结尾处，在结尾之前子粘贴下面的行

For Each sh In ActiveWorkbook.Worksheets
        sh.Protect Password:=yourPassword
    Next sh

---

发布您的代码。取消保护然后保护应该有效感谢您的响应。我认为它确实应该有效，但由于这是我第一次处理代码，我可能做了一些错误的事情。您是对的，工作非常完美！非常感谢您花时间！没问题。您是否在开始时使用了取消保护然后保护的解决方案最后，请回答，或者是更改重复工作表名称的解决方案？如果你需要的话，请接受答案。嗨，Jamie，我真的很感谢你的帮助。因为你在这个问题上的帮助很成功，我想知道你是否也有以下问题的解决方案。我将把文件分发给许多人不同的人对宏没有任何经验。这些人希望用不同的密码锁定工作簿中的工作表。据我所知，宏工作的唯一方法是这些人进入宏并在以下位置输入密码：Sub UnprotectAll（）Dim sh As worket Dim yourPassword As String yourPassword=“人们必须在此处输入密码”，然后在宏的末尾再次输入密码

Dim sh As Worksheet

Dim yourPassword As String

    yourPassword = "whatever password you like"

   For Each sh In ActiveWorkbook.Worksheets
        sh.Unprotect Password:=yourPassword

For Each sh In ActiveWorkbook.Worksheets
        sh.Protect Password:=yourPassword
    Next sh