| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Can anybody help please? Urgent
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 . |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Can anybody help please? Urgent
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 . |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Can anybody help please? Urgent
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 . |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 . |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Can anybody help please? Urgent
Marcotte,
Thanks for your comments. But my problem is to add somehting to an existing code. For instance, is there a way to put a password to this Workbook Open, it is already protected but without password, I want to add a password valid for all the sheets. Also, can you tell me the meaning of True (4 times in a row)? Thanks for any help Alex 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 "Marcotte A" wrote in message ... You want to put the .Unprotect code at the beginning of your macro (either first line or immedietly after the dim statements - but before any code that makes changes). And you want to put the .Protect code at the very end of your macro. Basically, each line of code is interpreted in order (with exceptions for if - then, loops etc.) If you have code that makes changes to a sheet with protection, it will fail. So you need a line of code that will turn protection off before the code that makes the changes gets executed. The easiest way to do this is put it at the very beginning. |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Can anybody help please? Urgent
No, Alex, not at all. I have sat - and am still sitting! - in your chair of
"don't know much about VBA". But Googling the NG to find how the question I want to ask has been answered before does two things: (a) it saves the wonderful MVPs here from repeating themselves five times a day! <G, and (b) it gave me examples of how the answer fit into different routines. Knowing how to find the ~previous~ answers gave me the power to find the answer *NOW!*, rather than wait for someone else to pick up my question. I wanted to pass this power on to you. It's how I learned. Also, given my relative inexperience, I have no other valid answers for you. I've never used that command, and don't know exactly how to use it correctly. But I do know that this question has been addressed before by people much more experienced than I am, and you can have access to all those answers with a simple search. The other "power tool" is to type your command on a line in the module window, make sure your cursor is in the command your having problems with, and press F1. For instance, type in ActiveWorksheet.Protect, make sure the cursor is somewhere inside Protect, and press F1. This brings up the Help file for Protect, which includes not only an explanation but also code examples. There's also the Knowledge Base and various MVP web pages. A nice add-in that I use all the time is found at http://www.rondebruin.nl/Google.htm. It allows me to search all the above - and I have often found the answer while I was waiting for someone else to pick up my thread in the NG! Others helped me climb this steep learning curve, Alex. And I'm trying to help you by passing along the same tools they gave me. Ed "Metallo" wrote in message ... 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 . |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Can anybody help please? Urgent
Ed,
Sometimes is difficult to do what you describe when you have time pressure. I looked to a similar situation in the NG, and still I'm looking to it, but cannot find a reply, at least, not a reply that I can easily transfer to my situation, that's why I keep on asking. I've been using forums since 1997 and I know very well how it works, I also know the sites you mention, but you need to go through them with a decent amount of time and not when you need to solve a sitution in a few hours. Thanks anyhow for your constructive comments. Alex "Ed" wrote in message ... No, Alex, not at all. I have sat - and am still sitting! - in your chair of "don't know much about VBA". But Googling the NG to find how the question I want to ask has been answered before does two things: (a) it saves the wonderful MVPs here from repeating themselves five times a day! <G, and (b) it gave me examples of how the answer fit into different routines. Knowing how to find the ~previous~ answers gave me the power to find the answer *NOW!*, rather than wait for someone else to pick up my question. I wanted to pass this power on to you. It's how I learned. Also, given my relative inexperience, I have no other valid answers for you. I've never used that command, and don't know exactly how to use it correctly. But I do know that this question has been addressed before by people much more experienced than I am, and you can have access to all those answers with a simple search. The other "power tool" is to type your command on a line in the module window, make sure your cursor is in the command your having problems with, and press F1. For instance, type in ActiveWorksheet.Protect, make sure the cursor is somewhere inside Protect, and press F1. This brings up the Help file for Protect, which includes not only an explanation but also code examples. There's also the Knowledge Base and various MVP web pages. A nice add-in that I use all the time is found at http://www.rondebruin.nl/Google.htm. It allows me to search all the above - and I have often found the answer while I was waiting for someone else to pick up my thread in the NG! Others helped me climb this steep learning curve, Alex. And I'm trying to help you by passing along the same tools they gave me. Ed "Metallo" wrote in message ... 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 . |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| IME MODE FOR EXCEL 2007 (URGENT URGENT) | Excel Discussion (Misc queries) | |||
| Sum IF-Urgent! | Excel Discussion (Misc queries) | |||
| Urgent-Urgent VBA LOOP | Excel Discussion (Misc queries) | |||
| Macro help urgent urgent | Excel Programming | |||
| Macro help urgent urgent | Excel Programming | |||
![Metallo[_4_] is offline](https://www.excelbanter.com/images/SultanThemeVB3R/statusicon/user_offline.gif)
Linear Mode
