Index of protected sheets

[Guest]

I have workbooks containing many protected worksheets. I would like to set
up an index page that shows the name of each worksheet and its current status
- protected or unprotected. Using the CELL function only gives the status of
a cell, does anyone know if there is an equivalent function/technique for the
entire worksheet? Thanks.

 

[Guest]

I believe the code below will do what you want.
It creates a Table of Contents worksheet.
It lists hyperlinks to each worksheet, Visible/Hidden,
Protected/Unprotected. Column D is for notes you might want to add for
descriptions of each worksheet.
Thanks for the idea! I've had this Table of Contents forever but never
thought to add the Protected/Unprotected information.

'==========================================
Public Sub Table_Of_Contents()
'Create a separate worksheet with the name of each sheet
' in the workbook as a hyperlink to that sheet -
' i.e. a TOC
'07/25/2000 - allow for chart sheets
'08/11/2005 - add Protect/Unprotect information
Dim iRow As Integer, iColumn As Integer, y As Integer
Dim i As Integer, x As Integer, iSheets As Integer
Dim objOutputArea As Object
Dim strTableName As String, strSheetName As String
Dim strOrigCalcStatus As String

strTableName = "Table_of_Contents"

'Count number of sheets in workbook
iSheets = ActiveWorkbook.Sheets.Count

'Check for duplicate Sheet name
i = ActiveWorkbook.Sheets.Count
For x = 1 To i
If Windows.Count = 0 Then Exit Sub
If UCase(Sheets(x).Name) = UCase(strTableName) Then
Sheets(x).Activate
If Err.Number = 9 Then
Exit For
End If
'turn warning messages off
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
'turn warning messages on
Application.DisplayAlerts = True
Exit For
End If
Next

'Add new sheet at end of workbook
' where results will be located
Sheets.Add.Move Before:=Sheets(1)

'Name the new worksheet and set up Titles
ActiveWorkbook.ActiveSheet.Name = strTableName
ActiveWorkbook.ActiveSheet.Range("A1").Value = _
"Worksheet (hyperlink)"
ActiveWorkbook.ActiveSheet.Range("B1").Value = _
"Visible / Hidden"
ActiveWorkbook.ActiveSheet.Range("C1").Value = _
"Prot / Un"
ActiveWorkbook.ActiveSheet.Range("D1").Value = _
" Notes: "

'Count number of sheets in workbook
iSheets = ActiveWorkbook.Sheets.Count

'Initialize row and column counts for putting
'info into StrTableName sheet
iRow = 1
iColumn = 0

Set objOutputArea = _
ActiveWorkbook.Sheets(strTableName).Range("A1")

'Check Sheet names
For x = 1 To iSheets
' Sheets(x).Activate
' strSheetName = ActiveSheet.Name
strSheetName = Sheets(x).Name
'put information into StrTableName worksheet
With objOutputArea
If strSheetName <> strTableName Then
.Offset(iRow, iColumn) = " " & strSheetName
If UCase(TypeName(Sheets(x))) <> "CHART" Then
Sheets(x).Hyperlinks.Add _
Anchor:=objOutputArea.Offset(iRow, _
iColumn), _
Address:="", SubAddress:=Chr(39) & _
strSheetName & Chr(39) & "!A1"
End If
If Sheets(x).Visible = True Then
.Offset(iRow, iColumn + 1) = " Visible"
.Offset(iRow, iColumn).Font.Bold = True
.Offset(iRow, iColumn + 1).Font.Bold = True
Else
.Offset(iRow, iColumn + 1) = " Hidden"
End If
If Sheets(x).ProtectContents = True Then
.Offset(iRow, iColumn + 2) = " P"
Else
.Offset(iRow, iColumn + 2) = " U"
End If
iRow = iRow + 1
End If
End With
Next x

Sheets(strTableName).Activate

'format worksheet
Range("A").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection.Font
.Name = "Tahoma"
'.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
'.ColorIndex = xlAutomatic
End With

Range("A2").Select
ActiveWindow.FreezePanes = True
Range("A1").Font.Bold = True
Columns("A").EntireColumn.AutoFit

Range("A11").Select
With Selection
.HorizontalAlignment = xlCenter
.Font.Underline = xlUnderlineStyleSingle
End With

Range("B1").Select
With ActiveCell.Characters(Start:=1, Length:=7).Font
.FontStyle = "Bold"
End With
With ActiveCell.Characters(Start:=8, Length:=9).Font
.FontStyle = "Regular"
End With

Columns("A").EntireColumn.AutoFit
Range("A11").Font.Underline = _
xlUnderlineStyleSingleAccounting

Range("B:B").HorizontalAlignment = xlCenter

Range("C1").WrapText = True
Columns("C:C").HorizontalAlignment = xlCenter
Rows("1:1").RowHeight = 100
Columns("C:C").ColumnWidth = 5.15
Rows("1:1").EntireRow.AutoFit

Range("D1").HorizontalAlignment = xlLeft
Columns("D").ColumnWidth = 65

'format print options
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintGridlines = True
.CenterHorizontally = True
.Orientation = xlPortrait
.FirstPageNumber = xlAutomatic
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With

Range("B1").Select

Selection.AutoFilter

Application.Dialogs(xlDialogWorkbookName).Show

End Sub
'==========================================

HTH,

 

[Guest]

Thanks, that's a great routine! Does exactly what I want and has notes as
well. It will be very helpful as I go through my revisions - it's a real
pain to check every sheet to ensure you protected it, this will make it much
easier. Thanks again.

 

[Paul B]

Alan, the code Gary gave you does what you want,
as you said
"it's a real pain to check every sheet to ensure you protected it, this
will make it much easier."
you may also want to use some code to protect all the sheets in the workbook
at one time, something like this

Sub protect_sheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Protect password:="123"
Next ws
End Sub


--
Paul B
Always backup your data before trying something new
Please post any response to the newsgroups so others can benefit from it
Feedback on answers is always appreciated!
Using Excel 2002 & 2003

 

[CLR]

Someone in the Group once gave me this piece of code........it may need
tweaking for your application.......


Public Sub ToggleProtectWithIndication()
'This will add "##" to the SheetName when you unprotect the sheet, and
remove it when you
'reprotect it.
Const PWORD As String = "drowssap"
Dim wkSht As Worksheet

With ActiveSheet
If .ProtectContents Then
.Unprotect Password:=PWORD
.Name = .Name & "##"
Else
.Protect Password:=PWORD
If .Name Like "*[##]" Then _
.Name = Left(.Name, Len(.Name) - 2)
End If
End With
End Sub


Vaya con Dios,
Chuck, CABGx3