Readdy Write  
0,00 €
Your View Money
Views: Count
Self 20% 0
Your Content 60% 0

Users by Links 0
u1*(Content+Views) 10% 0
Follow-Follower 0
s2*(Income) 5% 0

Count
Followers 0
Login Register as User

Excel Vorlage: Datei Schutz mit erlaubtem Farbformatierungen, Kommentaren und Sperren von Formelfeldern

06.06.2019 (­čĹü81)

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