表保護時，宏不起作用。運行宏返回運行時錯誤1004

Question

我的工作簿中有三個宏可以正常工作。但是，當我保護任何工作表時，他們停止工作，我得到run-time error 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 

Answer 1

您沒有任何代碼在日在宏觀開始時不再保護，然後在最後保護。你一開始就需要這樣的東西（我想你已經知道這一點，但只是想澄清）。

SheetName.Unprotect Password:=yourPassword 

這結尾：

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.ScreenUpdating = False以避免閃爍，因爲它在所有工作表中循環，然後在Macro1的末尾添加Application.ScreenUpdating = True。

Answer 2

宏觀初學者求助：

如果您正在使用一個按鈕來運行宏， 包括以下內部子buttonclick（）

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