要保护Excel工作簿防止在不同电脑间复制,可以使用以下代码示例:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim filePath As String
filePath = ThisWorkbook.Path & "\"
' 将工作簿保存为一个临时文件
ThisWorkbook.SaveCopyAs filePath & "TempWorkbook.xlsx"
' 将临时文件设置为只读
SetAttr filePath & "TempWorkbook.xlsx", vbReadOnly
' 锁定工作簿结构,防止插入、删除、移动工作表等操作
ThisWorkbook.Protect Structure:=True, Windows:=False
End Sub
Private Sub Workbook_Open()
Dim filePath As String
filePath = ThisWorkbook.Path & "\"
' 解锁工作簿结构
ThisWorkbook.Unprotect Structure:=True
' 如果存在临时文件,则关闭工作簿
If Dir(filePath & "TempWorkbook.xlsx") <> "" Then
ThisWorkbook.Close SaveChanges:=False
MsgBox "该工作簿不能在不同电脑间复制。", vbInformation
End If
' 删除临时文件
On Error Resume Next
Kill filePath & "TempWorkbook.xlsx"
On Error GoTo 0
End Sub
这段代码包含两个事件处理程序:Workbook_BeforeSave
和Workbook_Open
。
Workbook_BeforeSave
事件处理程序在保存工作簿之前执行。它将工作簿保存为一个临时文件,并将该文件设置为只读。然后,它使用Protect
方法锁定工作簿结构,防止插入、删除、移动工作表等操作。
Workbook_Open
事件处理程序在打开工作簿时执行。它首先解锁工作簿结构,然后检查是否存在临时文件。如果存在临时文件,则关闭工作簿并显示一个消息框,提示用户该工作簿不能在不同电脑间复制。最后,它删除临时文件。
请注意,在使用这段代码之前,你需要将其放置在工作簿的VBA编辑器中。可以按下Alt + F11
打开VBA编辑器,然后将代码复制粘贴到ThisWorkbook
对象的代码窗口中。