PDA

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)