VBA，禁止修改workbook的所有内容

 

1 代码1：禁止修改工作簿所有内容

• 在workbook的  sheetchange() 里增加判断
• 只要内容发生变化，触发 sheetchange()  就把 target参数内容置回之前的内容
• 需要事先捕捉，修改前的 范围内容

 

Dim arr1

Private Sub Workbook_Open()
MsgBox "此工作簿不允许修改"
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
MsgBox "此工作簿不允许修改"
Application.EnableEvents = False
Target.Value = arr1
Application.EnableEvents = True

End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
arr1 = Target.Value
End Sub

 

 

2  Workbook_SheetChange() 和 application.undo

2.1 极易卡死的 死循环代码Workbook_SheetChange() 和 application.undo

• application.undo 虽然是放弃当前操作
• 但是 Workbook_SheetChange() 会再次检测到，发生变化，继续触发 sheetchange()
• 怀疑是因为 事件触发优先级更高，代码后半部分未执行完毕被打断，重新开始循环了

 

死循环1

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

'Application.Undo
'end       都没用，还是循环卡死，怀疑是因为 事件触发优先级更高，代码未执行完毕被打断，重新开始循环了
'exit sub  都没用，还是循环卡死


End Sub

 

死循环2

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

'i = 1
'If i = 1 Then
'MsgBox "本工作簿不允许修改"
'Application.Undo
'i = 0
'End If


End Sub

 

2.2  在事件执行过程中，禁止触发其他事件，避免出错

• Application.EnableEvents = False
• 可以防止在执行 本次 workbook_sheetchange()过程 再次被触发自身，陷入循环

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Application.EnableEvents = False
MsgBox "本工作簿不允许修改"
Application.Undo
Application.EnableEvents = True

End Sub

 

2.3 禁止修改第3列的内容

• 限制范围
• 注意也要用 application.enableevents

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Application.EnableEvents = False

If Target.Column = 3 Then
MsgBox "本工作簿第3列不允许修改"
Application.Undo
End If

Application.EnableEvents = True

End Su

 

2.4 判断sheetchange() 输入的内容，进行修改

判断A列的方法

• Split(Target.Address, "$")(1) = "A" Then
• target.column=1

局限性

• 如果用输入数组公式方法，一次改多个单元格就报错，而且报错后就不好用了
• 或者一次给A列多个单元格复制过去多个值，也会报错后不好用

 

常见方法，把target默认为cell，有局限性，因为 selectchange()可以是一个区域range

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Application.EnableEvents = False

If Split(Target.Address, "$")(1) = "A" Then
   Debug.Print "这种方法也可以判断是不是A列"
End If

If Target.Column = 1 And Target.Value = 11 Then
   Rows(Target.Row).Interior.ColorIndex = 6
End If

Application.EnableEvents = True

End Sub

 

正确思路，把target 当range处理，可以支持多个单元格变化

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)


Application.EnableEvents = False

'直接使用 target 这个range的元素和行列号，支持选择区域
Dim c1 As Object
For Each c1 In Target
    If c1.Column = 1 And c1.Value = 11 Then
'    If c1.Value = 11 Then   '这样可以支持多列判断单元格的值
       Rows(c1.Row).Interior.ColorIndex = 6
    End If
Next


'数组的思路可能不太行，因为这里需要的是 Excel 内的行号，列号，直接用range比较好
'Dim arr1()
'arr1() = Target  '因为target，是range对象，本身是1个二维数组,但是这样index不是excel下标了不行吧
'For i = LBound(arr1) To UBound(arr1)
'    For j = LBound(arr1, 2) To UBound(arr1, 2)
'    Next
'Next


Application.EnableEvents = True

 

 

 

3 如果只是每次想控制一些变量

可以考虑把这些变量设置为 模块级变量 public，每次开始运行/ 每次打开WB时，重置可以保证这几个值不变

 

 

4 参考

网上有人讨论的只让修改单个单元格，并且不同日期只能修改某些内容

http://club.excelhome.net/thread-963970-1-1.html