vba 工作表受保护时，宏不起作用。运行宏返回运行时错误 1004
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/12932254/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Macros don't work when sheet is protected. Running macro returns run-time error 1004
提问by Miles
I have three macros in my workbook that work fine. However, when I protect any of the worksheets, they stop to work and I get a run-time error 1004.
我的工作簿中有三个可以正常工作的宏。但是，当我保护任何工作表时，它们会停止工作并且我得到run-time error 1004.
I have tried following the two suggestions that I found online:
我尝试遵循我在网上找到的两个建议：
- Unprotect at start of macro code, and protect at end;
- User Interface Only) but the run-time error remains.
- 宏代码开头unprotect，结尾protect；
- 仅限用户界面）但运行时错误仍然存在。
I need my Workbook to be protected and for my macros to function, what shall I do?
我需要保护我的工作簿并使我的宏正常运行，我该怎么办？
Macro 1:
宏 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
Macro 2
宏 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
Macro 3
宏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
回答by Jamie Bull
You don't have any code in there to unprotect at the start of the macro and then protect again at the end. You need something like this at the start (I think you already know this but just trying to be clear).
您没有任何代码可以在宏开始时取消保护，然后在最后再次保护。你一开始就需要这样的东西（我想你已经知道这一点，但只是想说清楚）。
SheetName.Unprotect Password:=yourPassword
And this at the end:
最后是这样的：
SheetName.Protect Password:=yourPassword
You say you've tried this already but it's not clear from the code you posted where you had these commands.
您说您已经尝试过此操作，但是从您发布的代码中不清楚这些命令的位置。
From trying to reproduce the behaviour at this end I notice you have two different worksheets you refer to as historyWkswhich could be causing problems with locking and unlocking.
通过在此尝试重现行为，我注意到您有两个不同的工作表，您引用historyWks它们可能会导致锁定和解锁问题。
One option is to unprotect all worksheets at your entry point then protect them again at the exit.
一种选择是在入口点取消保护所有工作表，然后在出口处再次保护它们。
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
You just need to call these at the start and end of your Macro1. You might also want to add an Application.ScreenUpdating = Falseat the start to avoid flicker as it loops through all the worksheets and then Application.ScreenUpdating = Trueat the end of Macro1.
你只需要在你的Macro1. 您可能还想Application.ScreenUpdating = False在开头添加，以避免在循环遍历所有工作表时出现闪烁，然后Application.ScreenUpdating = True在Macro1.
回答by Vipin Jose
help for macro beginners:
对宏初学者的帮助：
if you are using a button to run a macro, include the following inside sub buttonclick()
如果您使用按钮来运行宏，请在子 buttonclick() 中包含以下内容
Dim sh As Worksheet
Dim yourPassword As String
yourPassword = "whatever password you like"
For Each sh In ActiveWorkbook.Worksheets
sh.Unprotect Password:=yourPassword
"now enter your macro which needs to be run
“现在输入需要运行的宏
,at the end , before end sub paste the below line
，最后，在结束子之前粘贴以下行
For Each sh In ActiveWorkbook.Worksheets
sh.Protect Password:=yourPassword
Next sh
