I'm looking to use a string for the password protection of the sheet
and workbook. I have a button that prompts the user to change the
password if necessary, but the string is empty in other parts of the
code.
' Initialization coding
Private Sub Worksheet_Activate()
Dim PW As String
PW = "password"
ActiveSheet.Protect Password:=PW, DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoSelection
ActiveWorkbook.Protect Password:=PW, Structure:=True,
Windows:=True
Application.DisplayFormulaBar = False
End Sub
__________________________________________
' Protection prompt
Private Sub Prot_Click()
Dim Response As Long
Response = MsgBox("Would you like to reset the password?",
vbYesNoCancel, "Password Reset")
Select Case Response
Case 6
PW = InputBox("Enter new password:", "Reset Password")
ActiveWorkbook.Protect Password:=PW, Structure:=True,
Windows:=True
ActiveSheet.Protect Password:=PW, DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoSelection
Case 7
ActiveWorkbook.Protect Password:=PW, Structure:=True,
Windows:=True
ActiveSheet.Protect Password:=PW, DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoSelection
Case 2
GoTo LineE
End Select
LineE:
End Sub
__________________________________________
' Unprotect prompt
Private Sub Unprot_Click()
Dim iPW
iPW = InputBox("Enter password.", "Protection Password")
If iPW = PW Then
ActiveWorkbook.Unprotect (PW)
ActiveSheet.Unprotect (PW)
Sheet1.Range("D6", Range("E6").End(xlDown).Offset(0,
1)).Select
With Selection.Interior
.ColorIndex = 0
.TintAndShade = 0
End With
With Selection.Font
.ColorIndex = 1
.TintAndShade = 0
End With
Cells(1, 1).Select
Else
lngR = MsgBox("Incorrect password.", vbOKOnly + vbCritical,
"FAIL")
End If
End Sub
The unprotection prompt is the one where it finds PW as Empty. So, if
I change PW in the protection prompt the unprotection does not
register PW for some reason. I'm trying to make the protection user
friendly and practical instead of going to the tab and doing whatever
(my superiors will enjoy this). Another problem I get is that when I
unprotect the sheet and workbook to do whatever it is I have the code
do, and the code protects it again, the password is not applied.
Private Sub Display_Click()
Dim DisplayName As String
Dim FullName As String
Dim CellName As String
Dim CellBlock As Range
FullName = UCase(RName.Text)
ActiveWorkbook.Unprotect (PW)
ActiveSheet.Unprotect (PW)
DisplayName = UCase(Left(RName, 6))
Sheet1.Range("D6", Range("E6").End(xlDown).Offset(0, 1)).Select
With Selection.Interior
.ColorIndex = 0
.TintAndShade = 0
End With
With Selection.Font
.ColorIndex = 2
.TintAndShade = 0
End With
Select Case FullName
Case "ALL"
If Password.Text = "password555" Then
GoTo LineR
Else
MsgBox "Incorrect password."
GoTo Line91
End If
Case ""
GoTo LineR
Case "J. SMITH"
If Password.Text = "password555" Then
GoTo LineR
Else
MsgBox "Incorrect user password."
GoTo Line91
End If
End Select
LineR:
If RName = Empty Then
Cells(1, 1).Select
lngR = MsgBox("No name entered!", vbOKOnly +
vbExclamation)
GoTo Line91
Else
Sheet1.Range("D6", Range("E6").End(xlDown).Offset(0,
1)).Select
With Selection.Font
.ColorIndex = 2
.TintAndShade = 0
End With
For Each CellBlock In Sheet1.Range("D6", Range("E6").End
(xlDown).Offset(0, 1).Address)
CellName = Left(CellBlock.Text, 6)
If CellName = DisplayName Then
CellBlock.Font.ColorIndex = 1
CellBlock.Interior.ColorIndex = 4
End If
Next CellBlock
Cells(1, 1).Select
MsgBox "All assignments for " & Chr(10) & Chr(10) & UCase
(FullName)
End If
Line91:
ActiveWorkbook.Protect Password:=PW, Structure:=True,
Windows:=True
ActiveSheet.Protect Password:=PW, DrawingObjects:=True,
Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoSelection
End Sub
I know this is quite lengthy, but any help on any of these parts would
be much appreciated. Thank you in advance!
Tim
--~--~---------~--~----~------------~-------~--~----~
Visit the blog to download Excel tutorials at
http://www.excel-macros.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
For more options, visit this group at
http://groups.google.com/group/excel-macros?hl=en
Visit & Join Our Orkut Community at
http://www.orkut.com/Community.aspx?cmm=22913620
To Learn VBA Macros Please visit http://www.vbamacros.blogspot.com
To see the Daily Excel Tips, Go to:
http://exceldailytip.blogspot.com
If you find any spam message in the group, please send an email to Ayush @
jainayus...@gmail.com
-~----------~----~----~----~------~----~------~--~---
