Macro with a Password Prompt routine

**edbhome** · 02-11-2009, 09:35 AM

I am trying to complete a toolbar that will lock and unlock all the sheets in a workbook. While I can set the password automatically I'd like to have the macro ask for the password instead of hardcoding it.

Here is the code I currently have and works so long as I have already set the password in the workbook to match what is in the macro

on Explicit
 
Public Const ToolBarName As String = "Password Protect Worksheets"
 
 
'===========================================
Sub CreateMenubar()
 
    Dim iCtr As Long
 
    Dim MacNames As Variant
    Dim CapNamess As Variant
    Dim TipText As Variant
 
    Call RemoveMenubar
 
    MacNames = Array("Protect", _
                     "unprotect")
 
    CapNamess = Array("Lock Sheets", _
                      "Un-Lock Sheets")
 
    TipText = Array("Lock Worksheets", _
                    "Unlock Worksheets")
 
    With Application.CommandBars.Add
        .Name = ToolBarName
        .Left = 200
        .Top = 200
        .Protection = msoBarNoProtection
        .Visible = True
        .Position = msoBarFloating
 
        For iCtr = LBound(MacNames) To UBound(MacNames)
            With .Controls.Add(Type:=msoControlButton)
                .OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
                .Caption = CapNamess(iCtr)
                .Style = msoButtonIconAndCaption
                .FaceId = 71 + iCtr
                .TooltipText = TipText(iCtr)
            End With
        Next iCtr
    End With
End Sub
 
'===========================================
Sub Unprotect()
    Dim Wks As Worksheet
    For Each Wks In ActiveWorkbook.Worksheets
        Wks.Unprotect password:="password"
        Next Wks
    MsgBox "All of the WorkSheets are Now Unlocked"
End Sub
 
'===========================================
Sub Protect()
    Dim Wks As Worksheet
    For Each Wks In ActiveWorkbook.Worksheets
        Wks.Protect password:="password"
    Next Wks
    MsgBox "All of the WorkSheets are now Locked"
End Sub

**edbhome** · 02-13-2009, 05:12 PM

After much work ... and surfing the net ... I was able to put together the following solution.

The code can be placed into one module and then saved as an "Add-In" in your Add-in folder for Office within your "
c:\Documents and Settings\[username]\Application Data\Microsoft\AddIns\[file-name.xla"

Once installed as an add-in it will automatically load each time you start excel ... it will dock itself to the left of the "Formatting Toolbar" and unload when you exit Excel.

The protect macro will prompt you for a password ... set all the sheets to only allow access to unprotected cells ... and lock every sheet in the active workbook.

The unlock macro will unlock all the sheets in your active workbook no matter how many you have so long as you provide the correct password.

Lastly,

You can add other macros to the toolbar if you desire.

Hope this saves others all the time and effort I went through working this out.

Option Explicit

Public Const ToolBarName As String = "Worksheet Password Protection"
'===========================================
Sub Auto_Open()
    Call CreateMenubar
End Sub
'===========================================
Sub Auto_Close()
    Call RemoveMenubar
End Sub

'===========================================
Sub RemoveMenubar()
    On Error Resume Next
    Application.CommandBars(ToolBarName).Delete
    On Error GoTo 0
End Sub

'===========================================

Sub CreateMenubar()

    Dim iCtr As Long
    Dim cmdbar As CommandBar
    Dim MacNames As Variant
    Dim CapNamess As Variant
    Dim TipText As Variant

    MacNames = Array("Protect", _
                     "Unprotect")

    CapNamess = Array("Lock Sheets", _
                      "Un-Lock Sheets")

    TipText = Array("Protect Sheets", _
                    "Un-Protect Sheets")
     
    With Application.CommandBars.Add
        .Name = "Worksheet Password Protection"
        .Left = CommandBars("Formatting").Width
        .RowIndex = CommandBars("Formatting").RowIndex
        .Protection = msoBarNoProtection
        .Visible = True
        .Position = 1
        

        For iCtr = LBound(MacNames) To UBound(MacNames)
            With .Controls.Add(Type:=msoControlButton)
                .OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
                .Caption = CapNamess(iCtr)
                .Style = msoButtonIconAndCaption
                .FaceId = 71 + iCtr
                .TooltipText = TipText(iCtr)
            End With
        Next iCtr
    End With
End Sub

'===========================================
Sub Protect()

    Dim pw As String
    Dim wks As Worksheet

    pw = InputBox("Password please ... Give it to me NOW!")

    On Error GoTo ErrHandler
    
    For Each wks In ActiveWorkbook.Worksheets
            wks.EnableSelection = xlUnlockedCells
            wks.Protect pw, Contents:=True, DrawingObjects:=True
            
    Next wks

    MsgBox "All worksheets are now Locked", vbOKOnly, "Yeah Me .. Woo Woo .. Yee Haw!"
    Exit Sub

ErrHandler:
    MsgBox "There was a password problem", vbCritical, "No soup for you!"

End Sub

'===========================================
Sub UnProtect()

    Dim pw As String
    Dim wks As Worksheet

    pw = InputBox("Password please ... Give it to me NOW!")

    On Error GoTo ErrHandler

    For Each wks In ActiveWorkbook.Worksheets
        wks.UnProtect pw
    Next wks

    MsgBox "All worksheets are now unlocked", vbOKOnly, "Yeah Me .. Woo Woo .. Yee Haw!"
    Exit Sub

ErrHandler:
    MsgBox "There was a password problem", vbCritical, "No soup for you!"

End Sub

**VBA Noob** · 02-13-2009, 05:15 PM

Thanks for sharing you're solution

VBA Noob

**edbhome** · 02-13-2009, 05:23 PM

You're welcome.

It was a bugger to get working right and I wound up on no less then 10 forums ... doing god knows how many google searches ... trying to figuring it out myself.

I am a VBA novice too be sure ... was quite the eye opener.

It all started with a 20 + sheet workbook that I created for all my properties to submit invoices and get approvals. I lock all the worksheets/cells with the exception of a couple of data/date/cost/description cells. Helps to prevent our property managers from messing up all the formulas and calculations.