Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

protecting a workbook

Posted on 2011-03-01
12
Medium Priority
?
418 Views
Last Modified: 2012-05-19
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
Comment
Question by:Frank Freese
  • 4
  • 4
  • 2
  • +1
12 Comments
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35008282
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
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35008313
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
 
LVL 8

Accepted Solution

by:
point_pleasant earned 1200 total points
ID: 35008358
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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 

Author Comment

by:Frank Freese
ID: 35009612
On the Input box, can the user enter in the password but the display is something like ****  ?
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35009621
0
 
LVL 30

Assisted Solution

by:SiddharthRout
SiddharthRout earned 600 total points
ID: 35009692
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
 

Author Comment

by:Frank Freese
ID: 35009796
do i copy all of this above code?
0
 
LVL 85

Assisted Solution

by:Rory Archibald
Rory Archibald earned 200 total points
ID: 35009823
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35009861
>>do i copy all of this above code?

Yes.

Sid
0
 
LVL 8

Expert Comment

by:point_pleasant
ID: 35009952
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
 

Author Comment

by:Frank Freese
ID: 35010050
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
 

Author Closing Comment

by:Frank Freese
ID: 35010074
thanks folks!
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

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.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

926 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question