Solved

protecting a workbook

Posted on 2011-03-01
12
410 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 300 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
Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

 

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 150 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 50 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

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

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

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

813 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now