View Full Version : Detect an unprotected worksheet automatically
brettdj
01-04-2006, 04:05 PM
I'm mucking around with a corporate template that sends a CDO message (bypassing Outlook) if a user attempts to unprotect a worksheet
I could muck around with the menu settings and disable the Protect options but this is more fun
Is there a smart way to detect an unprotected sheet - I'm using the code below but I was wondering if there was a smarter way (class module?) to detect an unprotected worksheet
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim ws As Worksheet, NotProt As Boolean
For Each ws In ThisWorkbook.Worksheets
If ws.ProtectContents = False Then
NotProt = True
Exit For
End If
Next
If NotProt Then Mail_Small_Text_CDO
End Sub
Cheers
Dave
Killian
01-04-2006, 06:41 PM
Hi Dave,
The way to use classes in this instance is to wrap a class around a Worksheet variable declared WithEvents and set up a collection to hold the class instances.
The collection can be populated with the Workbook_Open and NewSheet events, then you can write your class event code to handle any worksheet... I hope I explained that ok :think:
For example, the class (called clsSheet) would look like this:Option Explicit
Private WithEvents m_ws As Worksheet
Public Sub Init(Sh As Object)
Set m_ws = Sh
End Sub
Private Sub Class_Terminate()
Set m_ws = Nothing
End Sub
Private Sub m_ws_Calculate()
If m_ws.ProtectContents = False Then
MsgBox m_ws.Name & " not protected"
End If
End Suband the Workbook code would be this:Option Explicit
Private colSheets As New Collection
Private wsSheet As clsSheet
Private Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
Set wsSheet = New clsSheet
wsSheet.Init ws
colSheets.Add wsSheet
Next
End Sub
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Set wsSheet = New clsSheet
wsSheet.Init Sh
colSheets.Add wsSheet
End Sub
johnske
01-04-2006, 07:06 PM
Dave,
I'm thinking why not be both sneeky and proactive here? - I'm assuming the VBE window is protected of course...Option Explicit
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
For Each Sh In ThisWorkbook.Worksheets
If Sh.ProtectContents = False Then
Mail_Small_Text_CDO
With Application
.EnableEvents = False
On Error Resume Next
.Undo '< undo any changes
.EnableEvents = True
End With
'set a NEW password here
Sh.Protect password:="123"
Exit For
End If
Next
End Sub
(edited to insert basic error handler)
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.