Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 421
  • Last Modified:

protecting a workbook

Experts,
In my workbook are many spreadsheets - each spreadsheet needs to have the formulas protected and each month I need to reset the data in the spreadsheet for the next month. It is very time consuming to unprotect each sheet, make my changes and then reprotect each worksheet.
Protect Workbook does not get me there. I would like to have two macros - one to unprotect all my worksheets at once and then another to protect my worksheets at once.
0
Frank Freese
Asked:
Frank Freese
  • 4
  • 4
  • 2
  • +1
3 Solutions
 
SiddharthRoutCommented:
Dim i As Long

Sub ProtectSheets()
    For i = 1 To ActiveWorkbook.Sheets.Count
     Sheets(i).Protect "MyPassword"
    Next i
End Sub

Sub UnProtectSheets()
    For i = 1 To ActiveWorkbook.Sheets.Count
     Sheets(i).Unprotect "MyPassword"
    Next i
End Sub

Open in new window


Sid
0
 
Rory ArchibaldCommented:
Const mcstrPASSWORD as string = "my password"

Sub ProtectAll()
dim wks as worksheet
for each wks in thisworkbook.worksheets
   wks.protect password:=mcstrPASSWORD
Next wks
End Sub
Sub UnprotectAll()
dim wks as worksheet
for each wks in thisworkbook.worksheets
   wks.unprotect password:=mcstrPASSWORD
Next wks
End Sub

Open in new window


for example
0
 
point_pleasantCommented:
Option Explicit
 
Sub ProtectAll()
     
    Dim wSheet          As Worksheet
    Dim Pwd             As String
     
    Pwd = InputBox("Enter your password to protect all worksheets", "Password Input")
    For Each wSheet In Worksheets
        wSheet.Protect Password:=Pwd
    Next wSheet
     
End Sub
 
Sub UnProtectAll()
     
    Dim wSheet          As Worksheet
    Dim Pwd             As String
     
    Pwd = InputBox("Enter your password to unprotect all worksheets", "Password Input")
    On Error Resume Next
    For Each wSheet In Worksheets
        wSheet.Unprotect Password:=Pwd
    Next wSheet
    If Err <> 0 Then
        MsgBox "You have entered an incorect password. All worksheets could not " & _
        "be unprotected.", vbCritical, "Incorect Password"
    End If
    On Error Goto 0
     
End Sub



To Use

Copy the code above
Open excel
Alt + 11 to open vbe
Insert/Module
Paste Code in to the code window
Close VBD

Tools/Macro/Mocros
Double click ProtectAll or UnprotectAll
0
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Frank FreeseAuthor Commented:
On the Input box, can the user enter in the password but the display is something like ****  ?
0
 
SiddharthRoutCommented:
0
 
SiddharthRoutCommented:
Here is a sample Attached.

Sid

Code Used

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 GetModuleHandle Lib "kernel32" Alias _
"GetModuleHandleA" (ByVal lpModuleName As String) As Long

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 SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) 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 GetCurrentThreadId Lib "kernel32" () As Long

'~~> Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

Private hHook As Long

Dim i As Long

Sub ProtectSheets()
    Dim Prompt, password As String
    Prompt = InputBoxDK("Please enter you password.")
    
    If Len(Trim(Prompt)) = 0 Then Exit Sub
    
    For i = 1 To ActiveWorkbook.Sheets.Count
        Sheets(i).Protect Prompt
    Next i
End Sub

Sub UnProtectSheets()
    Dim Prompt, password As String
    Prompt = InputBoxDK("Please enter you password.")
    
    If Len(Trim(Prompt)) = 0 Then Exit Sub
        
    For i = 1 To ActiveWorkbook.Sheets.Count
     Sheets(i).Unprotect Prompt
    Next i
End Sub

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
    Dim RetVal
    Dim strClassName As String, lngBuffer As Long

    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
        Exit Function
    End If

    strClassName = String$(256, " ")
    lngBuffer = 255
    
    If lngCode = HCBT_ACTIVATE Then
        RetVal = GetClassName(wParam, strClassName, lngBuffer)
        '~~> Class name of the Inputbox
        If Left$(strClassName, RetVal) = "#32770" Then
            '~~> This changes the edit control so that it display the password character *.
            '~~> You can change the Asc("*") as you please.
            SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If
    End If

    '~~> This line will ensure that any other hooks that may be in place are
    '~~> called correctly.
    CallNextHookEx hHook, lngCode, wParam, lParam

End Function

Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
Optional YPos, Optional HelpFile, Optional Context) As String
    Dim lngModHwnd As Long, lngThreadID As Long
    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
    InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
    UnhookWindowsHookEx hHook
End Function

Open in new window

Sample---Protect-Unprotect.xls
0
 
Frank FreeseAuthor Commented:
do i copy all of this above code?
0
 
Rory ArchibaldCommented:
I'd use a userform with a textbox on it with its PasswordChar property set to * personally. It's a lot less fannying about that all that API stuff. :)
0
 
SiddharthRoutCommented:
>>do i copy all of this above code?

Yes.

Sid
0
 
point_pleasantCommented:
On the Input box, can the user enter in the password but the display is something like ****  ?


Yes that blocks any one looking over your shoulder from seeing what you are typing, should work fine just have to remember the password when unprotecting



Mike
0
 
Frank FreeseAuthor Commented:
a lot of great options here - I've never created a user form and would like to travel down that road - I'm closing this to assign points and opening a new one for creating a user form.
0
 
Frank FreeseAuthor Commented:
thanks folks!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 4
  • 4
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now