Macro containing password?

[kildevil]

Is it possible to place a password on the protection feature of a
worksheet and program a macro to run without stopping to request the
password?

I share workbooks with others and protect cells to prevent
reconfiguration. Several workbooks contain macros. Usually the first
step in the macro is to remove the protection from the worksheet before
manipulating the data. The last step is to return the protection to the
worksheet. I have problems with others manually removing the protection
and doing "their thing" to the workbook. If I place a password on the
protection, the macro stops and asks for the password, so I normally
place the protection on without a password. It stops the casual user,
but not those intent on modifying my spreadsheet. I want to continue
sharing the workbooks, so I live with the "help".

Can I prevent this help and still run my macros?

Thank you for any help.

 

[Tim Williams]

Dim bProtected As Boolean
Const PW as string = "PWord"

If Sheet1.ProtectContents Then
Sheet1.Unprotect PW
bProtected = True
End If

'do stuff here

If bProtected Then Sheet1.Protect PW


Tim.

 

[KL]

Hi,

Here you have everything you need to protect/unprotect your sheets
dinamically. Bear in mind that this is not a real protection (MS Office
password protection can be broken easily and, if you don't protect the VBA
Project, anyone could find the password in the code). However, this is just
what you need for the purposes you described below. The first code line
contains the password constant (feel free to change "password" to your
preferred one). The last macro is an example of how you could ask the user
for password and based on the input unprotect or deny access. Anyway, if you
need to programmatically modify the sheet, you don't need to ask user to
enter password, just start your code with a call to one of the
unprotect-type macros and finish with a protect one. Hope this helps. KL.

'------Start Code-----
Global Const Pass = "password"
'This is the password constant

Sub ProtectSheetsAll()
'This protects all sheets
'in the workbook
For Each s In ThisWorkbook.Sheets
s.Protect Pass
Next s
End Sub

Sub UnprotectSheetsAll()
'This unprotects all sheets
'in the workbook
For Each s In ThisWorkbook.Sheets
s.Unprotect Pass
Next s
End Sub

Sub ProtectSheets()
'This protects the first 3 sheets
'in the workbook
For s = 1 To 3
ThisWorkbook.Sheets(s).Protect Pass
Next s
End Sub

Sub UnprotectSheets()
'This unprotects the first 3 sheets
'in the workbook
For s = 1 To 3
ThisWorkbook.Sheets(s).Unprotect Pass
Next s
End Sub

Sub ProtectSheetsSelected()
'This protects selcted sheets
'either by number o name
Dim MyArray As Variant
MyArray = Array(1, 5, 7, 12)
'Also: MyArray = Array("Sheet1",
'"Sheet5", "Sheet7", "Sheet12")
For Each i In MyArray
ThisWorkbook.Sheets(i).Protect Pass
Next i
End Sub

Sub UnprotectSheetsSelected()
'This unprotects selcted sheets
'either by number o name
Dim MyArray As Variant
MyArray = Array(1, 5, 7, 12)
'Also: MyArray = Array("Sheet1",
'"Sheet5", "Sheet7", "Sheet12")
For Each i In MyArray
ThisWorkbook.Sheets(i).Unprotect Pass
Next i
End Sub

Sub ProtectWB()
'This protects the workbook
ThisWorkbook.Protect Pass
End Sub

Sub UnprotectWB()
'This unprotects the workbook
ThisWorkbook.Unprotect Pass
End Sub

Sub RequirePassword()
Dim UserResponse
UserResponse = InputBox("Please enter password: ", _
"Restricted Access")

If UserResponse = Pass Then
UnprotectSheetsAll
Else
msg = "You have entered an" & Chr(13)
msg = msg & "incorrect password." & Chr(13)
msg = msg & "Please contact Kildevil"

MsgBox msg, vbCritical + vbOKOnly
End If
End Sub
'------End Code-----