PSW for Macro & Codes

M

Metallo

In my WB I have, Macros (for formatting) and Codes (below).
Option Explicit

Dim arySheets
Click to expand...

Private Sub Workbook_Open()
'''Enable Outlining navigation and protect everything on the sheet with UserInterfaceOnly.

Sheet2.EnableOutlining = True
Sheet2.Protect , True, True, True, True
Sheet8.EnableOutlining = True
Sheet8.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
Sheet15.EnableOutlining = True
Sheet15.Protect , True, True, True, True
Sheet16.EnableOutlining = True
Sheet16.Protect , True, True, True, True
Sheet17.EnableOutlining = True
Sheet17.Protect , True, True, True, True
Sheet18.EnableOutlining = True
Sheet18.Protect , True, True, True, True
Sheet19.EnableOutlining = True
Sheet19.Protect , True, True, True, True
Sheet20.EnableOutlining = True
Sheet20.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("Sheet9", "Sheet10", "Sheet11", "Sheet12",
Click to expand...
"Sheet13", "Sheet15", "Sheet16", "Sheet17", "Sheet18", "Sheet20")
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
Click to expand...

I want to add a PSW to avoid that the users do mistakes or changes in the WS

What is the code I can use to add the PSW and where shall I place it?

My intention is to use the VBA project properties to hide the PSW.

Thank you
Alex
 
P

Peter Beach

Hi Alex,

If by PSW you mean "password", go to the Project Explorer (normally docked
to the left-hand side of the screen) and right click with the mouse on the
VBA Project item and select Properties. A window will pop up, go to the
Protection Tab and set your password and enable protection.

HTH

Peter Beach
 
M

Metallo

Peter,

What you gave me is the final part.
What I need is to add a password in the code so that the user cannot
unprotect the sheets.
Then I will use the function you described to hide the password in the code.

Thanks
Alex
 
P

Peter Beach

Hi Alex,

The password is hidden by XL. You enter your own choice of password and
unless the user knows the password they won't be able to unprotect the code.
They will still be able to use the workbook, but they just won't have access
to the VBA code. Am I misunderstanding something?

BTW be aware that these passwords are relatively easily cracked by
commercial products.

Regards,

Peter Beach
 
M

Metallo

Peter,

I think is better that I enclose the formatting macro as well.
The macro as it is now, unprotects and protects again in order to apply the
formatting.
So my questions are two:

1) Where do I place the password in the code? (enclosed in my previous
message)
1) Where do I place the password in the macro? (below)

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").Select
Range("AD17").Activate
ActiveWindow.SmallScroll Down:=-5
Range("A41:AD41,A35:AD35,A29:AD29,A23:AD23,A17:AD17,A11:AD11").Select
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").Select
Range("AD29").Activate
ActiveWindow.SmallScroll Down:=16
Range("A11:AD11,A17:AD17,A23:AD23,A29:AD29,A35:AD35,A41:AD41").Select
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
 
M

Metallo

Peter,

Yes, you misunderstood.
read my following mail, please.
I need to protect the sheets first with a password and then use vba to hide
it.

Alex
 
P

Peter Beach

Hi Alex,

On my systems (XL2k and XL XP) the first optional argument for the .Protect
method of the worksheet is the password.

e.g.
Sub A()
Dim WS As Worksheet

Set WS = ThisWorkbook.Worksheets(1)

WS.Protect "password"
End Sub

Regards,

Peter Beach
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Selecting multiple sheets 3
Can anybody help please? Urgent 7
Group worksheets 8
open file contain 2
Cell name to change name in codes of command buttons 0
Using a macro to create multiple PivotTables 2
Hide/Unhide in Code; Protect, Unlock, etc. 3
Extra feauture to the following code 0

Top