Option Explicit
'============< Functions
>============
Public Function
hide_all_System_Worksheets()
'--------< hide_all_System_Worksheets() >--------
'*hide all worksheets where name starts with _
'*hide: very hidden
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim ws As Worksheet
For Each ws In wb.Sheets
If ws.Name Like "*Query" Then
ws.Visible = xlSheetVeryHidden
End If
Next
'--------</ hide_all_System_Worksheets() >--------
End Function
Public Function show_all_Worksheets()
'--------< show_all_Worksheets() >--------
'*show: show all hidden and very hidden files
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim ws As Worksheet
For Each ws In wb.Sheets
'If ws.Name Like "_*" Then
ws.Visible = xlSheetVisible
'End If
Next
'--------</ show_all_Worksheets() >--------
End Function
Public Function Protect_Worksheets()
'--------< Protect_Worksheets() >--------
'*hide all worksheets where name starts with _
'*hide: very hidden
On Error Resume Next
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim ws As Worksheet
For Each ws In wb.Sheets
If ws.Visible = xlSheetVisible Then
Protect_Worksheet ws
End If
Next
'--------</ Protect_Worksheets() >--------
End Function
Public Function
Protect_Worksheet(ByRef ws As Worksheet)
'--------< Protect_Worksheets() >--------
'*protect worksheet
If ws.Visible = xlSheetVisible Then
'*protect all visible worksheets
'< check: isProtected >
If ws.ProtectContents = True Or ws.ProtectDrawingObjects = True Or
ws.ProtectScenarios = True Then
ws.Unprotect °const_Password
End If
'</ check: isProtected >
'< worksheet.Protect >
ws.Protect °const_Password, Contents:=True _
, DrawingObjects:=False,
AllowFormattingCells:=True, AllowFormattingColumns:=True,
AllowFormattingRows:=True, AllowInsertingHyperlinks:=True _
, Scenarios:=True,
UserInterfaceOnly:=True, AllowInsertingColumns:=False,
AllowInsertingRows:=False _
, AllowDeletingColumns:=False,
AllowDeletingRows:=False _
, AllowSorting:=False,
AllowFiltering:=True, AllowUsingPivotTables:=True
'< worksheet.Protect >
End If
'--------</ Protect_Worksheets() >--------
End Function
Public Function Unprotect_Worksheets()
'--------< Unprotect_Worksheets() >--------
'unprotect all worksheets
On Error Resume Next
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim ws As Worksheet
For Each ws In wb.Sheets
If ws.Visible = xlSheetVisible Then
ws.Unprotect °const_Password
End If
Next
'--------</ Unprotect_Worksheets() >--------
End Function
'***********< Schutz und Eingabe
>****************
Public Function
Schutz_Sperren_nach_Muster_in_Arbeitsmappe(ByRef wb As Workbook)
'-----------------< Schutz_Sperren_nach_Muster_in_Arbeitsmappe()
>-----------------
'--< @Loop: alle Sheets >--
Dim ws As Worksheet
For Each ws In wb.Sheets
If ws.Visible = xlSheetVisible Then
Schutz_Zellen_Sperren_nach_Muster_in_Blatt wb, ws
End If
Next
'--< @Loop: alle Sheets >--
Application.StatusBar = ""
'-----------------</ Schutz_Sperren_nach_Muster_in_Arbeitsmappe()
>-----------------
End Function
Public Function
Schutz_Zellen_Sperren_nach_Muster_in_Blatt(ByRef wb As Workbook, ByRef ws As
Worksheet)
'-----------------< Schutz_Zellen_Sperren_nach_Muster_in_Blatt()
>-----------------
'On Error Resume Next
'< check: abbruch >
If Not ws.Visible = xlSheetVisible Then 'nur sichtbare seiten
Exit Function
End If
'</ check: abbruch >
'< check: Protected >
'*wenn das Blatt geschuetzt ist, kann der Zell-Schutz nicht aktiviert
werden
Dim IsProtected As Boolean
IsProtected = False
If ws.ProtectContents = True Then
ws.Unprotect °const_Password
IsProtected = True
End If
'</ check: Protected >
Application.StatusBar = Now & " Start: Zellen sperren in
Blatt " & ws.Name
'vSheet.Activate
Dim range_Cells As Range
Set range_Cells = Nothing
Dim cell As Range
For Each cell In ws.UsedRange.Cells
' Application.StatusBar = Now &
" check locked " & ws.Name & "." &
cell.Address
' DoEvents
If cell.HasFormula Then
'-< Ist_Zelle_mit_Formel >-
If Not cell.Locked = True Then
cell.Locked = True
'-</ Ist_Zelle_mit_Formel
>-
End If
Next
ws.Cells(1, 1).Locked = True
'< Protected_anpassen >
Protect_Worksheet ws
'</ Protected_anpassen >
'-----------------</ Schutz_Zellen_Sperren_nach_Muster_in_Blatt()
>-----------------
End Function
Public Function
Schutz_Gesperrte_Felder_anzeigen_in_Arbeitsmappe(ByRef wb As Workbook)
'-----------------<
Schutz_Gesperrte_Felder_anzeigen_in_Arbeitsmappe() >-----------------
'----< Sheets ermitteln >----
'--< @Loop: alle Sheets >--
Dim ws As Worksheet
For Each ws In wb.Sheets
Schutz_Gesperrte_Felder_anzeigen_in_Blatt wb, ws
Next
'--< @Loop: alle Sheets >--
Application.StatusBar = ""
'-----------------</
Schutz_Gesperrte_Felder_anzeigen_in_Arbeitsmappe() >-----------------
End Function
Public Function
Schutz_Gesperrte_Felder_anzeigen_in_Blatt(ByRef wb As Workbook, ByRef ws As
Worksheet)
'-----------------< Schutz_Gesperrte_Felder_anzeigen_in_Blatt()
>-----------------
'On Error Resume Next
'< check: abbruch >
If Not ws.Visible = xlSheetVisible Then 'nur sichtbare seiten
Exit Function
End If
'</ check: abbruch >
Application.StatusBar = Now & " Start: Markiere Eingabefelder
in Blatt " & ws.Name
'vSheet.Activate
Dim range_Cells As Range
Set range_Cells = Nothing
Dim cell As Range
For Each cell In ws.UsedRange.Cells
' Application.StatusBar = Now & "
check locked " & ws.Name & "." & cell.Address
' DoEvents
If cell.Locked = True Then
'-< Ist_gesperrt >-
'< Zellbereich verbinden >
If range_Cells Is Nothing Then
Set range_Cells = cell
Else
Set range_Cells =
Union(range_Cells, cell)
End If
'-</ Ist_gesperrt >-
'</ Zellbereich verbinden >
End If
Next
If Not range_Cells Is Nothing Then
Application.ScreenUpdating = True
ws.Activate
range_Cells.Select
End If
'Set range_Cells = Nothing
'< Abschluss >
'ws.Activate
'Application.StatusBar = ""
'</ Abschluss >
'-----------------</
Schutz_Gesperrte_Felder_anzeigen_in_Blatt() >-----------------
End Function
'================</ Funktionen
>===============
|