Can anybody help please? Urgent
If you don't know VB it's hard to understand, otherwise I didn't need to
write in this NG.
For you it's probably a joke to show me where to place the code...
Thanks
Alex
"Ed" wrote in message
...
A Google search of groups using
protect worksheet password VBA group:*excel*
pulled up many previous posts with various code examples. You can
probably
find one that best fits your needs.
Ed
"Metallo" wrote in message
...
Greg,
Could you please be a bit more specific, by showing me where to place
the
snippet in the Codes and the Macro enclosed.
Thank you
Alex
"Gjones" wrote in message
...
Hi Alex;
Here is a code snippet on how to do it.
Sub DoProtectWithPassword()
ActiveSheet.Protect Password:="MyPassWord"
ActiveSheet.Unprotect Password:="MyPassWord"
End Sub
Thanks,
Greg
-----Original Message-----
This is referring to a thread I started yesterday, but
apparently is
difficult to get a reply to a "simple" question (I'm sure
for you it is),
therefore I try again.
In my WB I have many Sheets.
I have also two WBOcodes and one macro.
The Workbook_Open codes a
1) To protect the sheets and allow outlining at the same
time.
2) To have a fix cell in selected sheets to change when a
number is input.
The Macro is to do some formatting.
In order to let it work, the macro includes a code the
temporarily unprotect
and reprotect the sheets.
What do I want to do? I want to add a password to the
sheet protection.
This means I have to do this for the macro as well.
My questions a
1) Where do I place the password in the Workbook_Open
code?
1) Where do I place the password in the macro?
I enclose both Workbook_Open codes and Macro.
WORKBOOK_OPEN CODES
Private Sub Workbook_Open()
'''Enable Outlining navigation and protect everything on
the sheet with
UserInterfaceOnly.
Sheet1.EnableOutlining = True
Sheet1.Protect , True, True, True, True
Sheet2.EnableOutlining = True
Sheet2.Protect , True, True, True, True
Sheet3.EnableOutlining = True
Sheet3.Protect , True, True, True, True
Sheet4.EnableOutlining = True
Sheet4.Protect , True, True, True, True
Sheet5.EnableOutlining = True
Sheet5.Protect , True, True, True, True
Sheet6.EnableOutlining = True
Sheet6.Protect , True, True, True, True
Sheet7.EnableOutlining = True
Sheet7.Protect , True, True, True, True
Sheet9.EnableOutlining = True
Sheet9.Protect , True, True, True, True
Sheet10.EnableOutlining = True
Sheet10.Protect , True, True, True, True
Sheet11.EnableOutlining = True
Sheet11.Protect , True, True, True, True
Sheet12.EnableOutlining = True
Sheet12.Protect , True, True, True, True
Sheet13.EnableOutlining = True
Sheet13.Protect , True, True, True, True
Sheet19.EnableOutlining = True
Sheet19.Protect , True, True, True, True
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object,
ByVal Target As Range)
Dim oSheet As Worksheet
On Error GoTo ws_exit:
arySheets = Array("2003", "Reduction Target
2004", "2004 Target", "2004
Act", "2004 Comp to 2003", "2004 Comp to 2003_ Volume
Only", "Diff of 2004
Comp, to 2003", "Diff of 2004 Comp, to 2004 Tgt ", "Diff
of 2004 Comp_VO,
to 2003", "Diff 2004 Comp_VO, to 2004 Tgt")
Application.EnableEvents = False
If SheetInArray(Sh.Name) Then
If Target.Address = "$B$5" Then
With Target
If .Value = 1 And .Value <= 12 Then
For Each oSheet In
ActiveWorkbook.Worksheets
If oSheet.Name < Sh.Name And
SheetInArray(oSheet.Name) Then
If oSheet.ProtectContents Then
oSheet.Unprotect
oSheet.Range("B5").Value
= .Value
oSheet.Protect
Else
oSheet.Range("B5").Value
= .Value
End If
End If
Next oSheet
Else
MsgBox .Value & " is an invalid value"
.Value = ""
End If
End With
End If
End If
ws_exit:
Application.EnableEvents = True
End Sub
Private Function SheetInArray(Name As String)
Dim fSheet As Boolean
Dim i As Long
fSheet = False
For i = LBound(arySheets, 1) To UBound(arySheets, 1)
If arySheets(i) = Name Then
fSheet = True
Exit For
End If
Next i
SheetInArray = fSheet
End Function
MACRO
Sub EasyProjectPrint()
'
' EasyProjectPrint Macro
' Macro recorded 27/06/2004 by bepaldo
'
'
Application.ScreenUpdating = False
Sheets("2003").Unprotect
Sheets("Reduction Target 2004").Unprotect
Sheets("2004 Target").Unprotect
Sheets("2004 Act").Unprotect
Sheets("2004 Comp to 2003").Unprotect
Sheets("2004 Comp to 2003_ Volume Only").Unprotect
Sheets("Diff of 2004 Comp, to 2003").Unprotect
Sheets("Diff of 2004 Comp, to 2004 Tgt ").Unprotect
Sheets("Diff of 2004 Comp_VO, to 2003").Unprotect
Sheets("Diff 2004 Comp_VO, to 2004 Tgt").Unprotect
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets(Array("2003", "Reduction Target 2004", "2004
Target", "2004 Act",
_
"2004 Comp to 2003", "2004 Comp to 2003_ Volume
Only", _
"Diff of 2004 Comp, to 2003", "Diff of 2004 Comp,
to 2004 Tgt ", _
"Diff of 2004 Comp_VO, to 2003", "Diff 2004
Comp_VO, to 2004
Tgt")).Select
Sheets("2003").Activate
Range("A9:AD47").Select
Selection.Interior.ColorIndex = 2
Range("A45:AD47").Select
Range("AD47").Activate
Selection.Font.ColorIndex = 0
Range("J6:J8").Select
ActiveWindow.SmallScroll ToRight:=16
Range("J6:J8,X6:X8,AB6:AB8,AD6:AD8").Select
Range("AD6").Activate
Selection.Font.ColorIndex = 2
Range("A41:AD41,A35:AD35,A29:AD29").Select
Range("AD29").Activate
ActiveWindow.SmallScroll Down:=-12
Range
("A41:AD41,A35:AD35,A29:AD29,A23:AD23,A17:AD17").S elect
Range("AD17").Activate
ActiveWindow.SmallScroll Down:=-5
Range
("A41:AD41,A35:AD35,A29:AD29,A23:AD23,A17:AD17,A11 :AD11").S
elect
Range("A11").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 16
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 16
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 16
End With
Range("AD9:AD47,AB9:AB47,X9:X47").Select
Range("X9").Activate
ActiveWindow.SmallScroll ToRight:=-17
Range("AD9:AD47,AB9:AB47,X9:X47,J9:J47").Select
Range("J47").Activate
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = 17
End With
ActiveWindow.SmallScroll Down:=-25
ActiveWindow.SmallScroll ToRight:=-20
Range("A1").Select
Sheets("2003").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("2003").Protect
Sheets("Reduction Target 2004").Protect
Sheets("2004 Target").Protect
Sheets("2004 Act").Protect
Sheets("2004 Comp to 2003").Protect
Sheets("2004 Comp to 2003_ Volume Only").Protect
Sheets("Diff of 2004 Comp, to 2003").Protect
Sheets("Diff of 2004 Comp, to 2004 Tgt ").Protect
Sheets("Diff of 2004 Comp_VO, to 2003").Protect
Sheets("Diff 2004 Comp_VO, to 2004 Tgt").Protect
Application.ScreenUpdating = True
End Sub
Sub MonitorView()
'
' MonitorView Macro
' Macro recorded 27/06/2004 by bepaldo
'
'
Application.ScreenUpdating = False
Sheets("2003").Unprotect
Sheets("Reduction Target 2004").Unprotect
Sheets("2004 Target").Unprotect
Sheets("2004 Act").Unprotect
Sheets("2004 Comp to 2003").Unprotect
Sheets("2004 Comp to 2003_ Volume Only").Unprotect
Sheets("Diff of 2004 Comp, to 2003").Unprotect
Sheets("Diff of 2004 Comp, to 2004 Tgt ").Unprotect
Sheets("Diff of 2004 Comp_VO, to 2003").Unprotect
Sheets("Diff 2004 Comp_VO, to 2004 Tgt").Unprotect
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets(Array("2003", "Reduction Target 2004", "2004
Target", "2004 Act",
_
"2004 Comp to 2003", "2004 Comp to 2003_ Volume
Only", _
"Diff of 2004 Comp, to 2003", "Diff of 2004 Comp,
to 2004 Tgt ", _
"Diff of 2004 Comp_VO, to 2003", "Diff 2004
Comp_VO, to 2004
Tgt")).Select
Sheets("2003").Activate
ActiveWindow.SmallScroll ToRight:=18
ActiveWindow.SmallScroll Down:=21
Range("A9:AD47").Select
Range("AD47").Activate
Selection.Interior.ColorIndex = 15
Range("A11:AD11,A17:AD17,A23:AD23,A29:AD29").Selec t
Range("AD29").Activate
ActiveWindow.SmallScroll Down:=16
Range
("A11:AD11,A17:AD17,A23:AD23,A29:AD29,A35:AD35,A41 :AD41").S
elect
Range("AD41").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 16
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 2
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 16
End With
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 9
Range("J9:J47").Select
ActiveWindow.SmallScroll ToRight:=15
Range("J9:J47,X9:X47,AB9:AB47,AD9:AD47").Select
Range("AD47").Activate
With Selection.Interior
.ColorIndex = 48
.Pattern = xlSolid
.PatternColorIndex = 17
End With
Range("AD6:AD8,AB6:AB8,X6:X8").Select
Range("X6").Activate
ActiveWindow.SmallScroll ToRight:=-15
Range("AD6:AD8,AB6:AB8,X6:X8,J6:J8").Select
Range("J6").Activate
Selection.Font.ColorIndex = 6
ActiveWindow.SmallScroll Down:=25
Range("A45:AD47").Select
Selection.Font.ColorIndex = 5
ActiveWindow.SmallScroll Down:=-25
ActiveWindow.SmallScroll ToRight:=-20
Range("A1").Select
Sheets("2003").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("2003").Protect
Sheets("Reduction Target 2004").Protect
Sheets("2004 Target").Protect
Sheets("2004 Act").Protect
Sheets("2004 Comp to 2003").Protect
Sheets("2004 Comp to 2003_ Volume Only").Protect
Sheets("Diff of 2004 Comp, to 2003").Protect
Sheets("Diff of 2004 Comp, to 2004 Tgt ").Protect
Sheets("Diff of 2004 Comp_VO, to 2003").Protect
Sheets("Diff 2004 Comp_VO, to 2004 Tgt").Protect
Application.ScreenUpdating = True
End Sub
I just need to see how this can be done and then I will
apply where needed.
Thank you
Alex
.
|