#

Download:

Datei 1: 20190605_Excel_schuetzen_07.xlsm

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 >===============

 

 

Mobile

.

123movies