Excel Vorlage: Datei Schutz mit erlaubtem Farbformatierungen, Kommentaren und Sperren von Formelfeldern
Die folgende Excel Datei zeigt auf, wie man eine Excel Datei mit einem Admin Funktionsblatt automatisch schützen kann, wobei nur die Zellen gesperrt werden welche eine Formel enthalten.
Die anderen Zellen bleiben zur freien Eingabe.
Zusätzlich ist der Worksheet.Protect Befehl so ausgelegt, dass die Formatierung von Zellen, das Einfügen von Kommentaren und Aus und Einblenden von Spalten möglich ist.
Nachträgliche Formeln sind natürlich ebenfalls erlaubt
Code Vorlage, Makro vba Code
Der Vba Code wird mit Alt+F11 eingeblendet
Vba Code
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 >===============
|