LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 21
Default Can anybody help please? Urgent

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

I just need to see how this can be done and then I will apply where needed.

Thank you
Alex


 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
IME MODE FOR EXCEL 2007 (URGENT URGENT) Stella Wong Excel Discussion (Misc queries) 1 August 23rd 08 11:16 PM
Sum IF-Urgent! Sue Excel Discussion (Misc queries) 5 April 6th 06 01:09 AM
Urgent-Urgent VBA LOOP Jeff Excel Discussion (Misc queries) 0 October 6th 05 05:46 PM
Macro help urgent urgent Dave Peterson[_3_] Excel Programming 0 September 4th 03 03:59 PM
Macro help urgent urgent chandra Excel Programming 0 September 4th 03 03:50 PM


All times are GMT +1. The time now is 11:59 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"