在另一个工作簿 vba 中取消保护和保护接收工作表

Question

我有 2 个工作簿。其中一个向另一个发送数据，一切正常。但是，现在我希望接收工作簿的工作表受到保护，并且在数据传输期间 VBA 应该取消保护，然后将所有想要的数据复制到它，最后再次保护接收工作表。我在这里想念什么？我使用 Worksheet.Unprotect 和复制数据，然后 Worksheet.Protect 最后保护接收工作表。我收到错误 400。我的代码如下，我使用按钮（表单控件）执行：

Sub Datatransfer()

Dim myPath As String 'this workbook path
Dim RecPath As String 'receiving workbook path
Dim RecFile As String 'receiving workbook complete name

RecPath = "C:\Users\" & Environ$("Username") & "\Documents\"
RecFile = "Data_Receive_Test.xlsx"

myPath = Application.ThisWorkbook.FullName


If Dir(RecPath & RecFile) = "" Then

MsgBox "The path to the receiving workbook is missing, please contact your admin!", vbCritical, _
"No access to receiving workbook!"

    Exit Sub

    ElseIf MsgBox("User: " & Environ("Username") & vbCrLf & vbCrLf & "Are you sure you want to copy the information below to the other workbook?" _
                & vbCrLf & vbCrLf & _
                "By choosing 'YES' the information below will overwrite the current information in the receiving workbook, which cannot be canceled later on!", _
                vbYesNo + vbExclamation, "Warning!") = vbNo Then
    Exit Sub
End If

'Define both workbooks
Dim x As Workbook 'this workbook
Dim y As Workbook 'receiving workbook

Set x = Workbooks.Open(myPath)
Set ws1 = x.Sheets("COMPLETED")

Dim rngCopy As Range

ws1.Range("A5").Select

Set rngCopy = ws1.Range("A5:B300")

rngCopy.Copy

Set y = Workbooks.Open(RecPath & RecFile)
Set ws2 = y.Sheets("TEST SHEET")

ws2.Select
ws2.Range("A5").Select

ws2.Unprotect Password:="TESTPROTECT"

Application.DisplayAlerts = False

ws2.Range("A5").PasteSpecial Paste:=xlPasteValues
ws2.Range("A3").Select

Application.CutCopyMode = False

ws2.Protect Password:="TESTPROTECT"

Application.DisplayAlerts = True

'Activate sending workbook (this) just to be sure
x.Activate
ws1.Range("A3").Select
ws1.Range("A3") = "Data transfer in progress..."

MsgBox "Data transfer in progress," & vbCrLf & vbCrLf & "both workbooks are being saved, please wait!", _
vbInformation + vbOKOnly, "Information!"


'Save both workbooks
y.Save
x.Save

'Close receiving workbook
y.Close True

ws1.Range("A3").Select

ws1.Range("A3") = "Data transfer completed!"

x.Save

MsgBox "Data transfer completed," & vbCrLf & vbCrLf & "both workbooks has been saved!", _
vbInformation + vbOKOnly, "Information!"

ws1.Range("A3") = ""
x.Save

Exit Sub

End Sub

Answer 1

不确定您在哪里出错，但您应该仅为用户保护工作簿，并让 VBA 在没有保护/取消保护的情况下工作。创建 Sub 并使用“UserInterfaceOnly:=True”保护您的工作簿并忘记痛苦：D。

Workbooks("myworkbook.xlsx").Sheets("sheet1").Protect "MyPass", UserInterfaceOnly:=True