Option Explicit
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function FindWindowEx _
Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE = 5
Private Const BM_CLICK = &HF5
Private lhHook As Long
Private bHookEnabled As Boolean
Private lTimerId As Long
Private oOutlinedColumns As Range
Private oRightColumnOfOutlinedRange As Range
'excel french version
'--------------------
Private Const FRENCH_EXCEL_PROTECTION_WARNING As String = _
"Vous ne pouvez pas exécuter cette commande sur une feuille"
'excel english version
'--------------------
Private Const ENGLISH_EXCEL_PROTECTION_WARNING As String = _
"You cannot use this command on a protected sheet"
Private sEXCEL_PROTECTION_WARNING As String
Private Const PASSWORD As String = "JON"
Sub CreateHook()
Dim Country_Code As Long
On Error Resume Next
'install a cbt hook to monitor for wnds creation
If Not bHookEnabled Then
Country_Code = Application.International(xlCountryCode)
If Country_Code = 1 Then
sEXCEL_PROTECTION_WARNING = ENGLISH_EXCEL_PROTECTION_WARNING
ElseIf Country_Code = 33 Then
sEXCEL_PROTECTION_WARNING = FRENCH_EXCEL_PROTECTION_WARNING
End If
Set oOutlinedColumns = _
Sheets(1).Columns("A:E") 'change this as required.
With oOutlinedColumns
Set oRightColumnOfOutlinedRange = _
.Columns(.Columns.Count).Offset(, 1)
End With
ActiveSheet.Unprotect
oRightColumnOfOutlinedRange.ShowDetail = False
ActiveSheet.Protect
lhHook = SetWindowsHookEx _
(WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
bHookEnabled = True
Else
MsgBox "Already enabled.", vbCritical
End If
End Sub
Sub DestroyHook()
'important to unhook when done!
UnhookWindowsHookEx lhHook
bHookEnabled = False
End Sub
Private Sub ValidatePassword()
Dim sPassword As String
sPassword = InputBox _
("Enter password to exapand the columns.", "Password")
If UCase(sPassword) = PASSWORD Then
Call TimerCaller
ElseIf sPassword = vbNullString Then
MsgBox "You Cancelled.", vbInformation
Else
MsgBox "Wrong password.", vbCritical
End If
End Sub
Private Sub TimerCaller()
lTimerId = SetTimer(0, 0, 1, AddressOf TimerProc)
End Sub
Private Sub TimerProc()
KillTimer 0, lTimerId
ActiveSheet.Unprotect
oRightColumnOfOutlinedRange.ShowDetail = True
End Sub
Private Function HookProc _
(ByVal idHook As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim strBuffer As String
Dim sBuffer2 As String
Dim lRetVal As Long
Dim lPromptTextHwnd As Long
Dim lPromptButnHwnd As Long
On Error Resume Next
If oRightColumnOfOutlinedRange.ShowDetail = False _
And ActiveSheet.ProtectContents = False Then
ActiveSheet.Protect
MsgBox "The sheet is now protected.", vbInformation
End If
'a wnd has been cretaed
If idHook = HCBT_ACTIVATE Then 'HCBT_CREATEWND Then
strBuffer = Space(256)
lRetVal = GetClassName(wParam, strBuffer, 256)
'is the wnd is the sheet tab window ?
If Left(strBuffer, lRetVal) = "#32770" Then
lPromptTextHwnd = _
FindWindowEx(wParam, 0, "MSOUNISTAT", vbNullString)
If lPromptTextHwnd <> 0 Then
sBuffer2 = Space(256)
GetWindowText lPromptTextHwnd, sBuffer2, 256
If InStr(1, Left(sBuffer2, Len(sBuffer2) - 1), _
sEXCEL_PROTECTION_WARNING, vbTextCompare) Then
lPromptButnHwnd = _
FindWindowEx(wParam, 0, "BUTTON", vbNullString)
Call DestroyHook
HookProc = 1
SendMessage lPromptButnHwnd, BM_CLICK, 0, 0
Call ValidatePassword
Call CreateHook
End If
End If
End If
End If
'Call next hook
HookProc = CallNextHookEx _
(lhHook, idHook, ByVal wParam, ByVal lParam)
End Function
