' **************************************************************
'  Modul:  Tabelle1  Typ = Element der Mappe(Sheet, Workbook, ...)
' **************************************************************

Option Explicit                                     ' Variablendefinition erforderlich

Private Sub Worksheet_Change(ByVal Target As Range)
    '**************************************************
    '* H. Ziplies                                     *
    '* 06.11.12                                       *
    '* erstellt von HajoZiplies@WEB.de                *
    '* http://Hajo-Excel.de/                          *
    '**************************************************
    ' 00 vor jede Eingabe in dem Bereich
    Dim RaBereich As Range                          ' Bereich der Wirksamkeit
    Dim RaZelle As Range                            ' aktuelle Zelle die bearbeitet wird
    ' Variable für NumberFormat, Stellen vor dem Komma+2, Stellen nach dem Komma
    Dim StZahl As String
    ' Fehlerbehandlung, falls doch mal ein Fehler kommt
    ' aus welchen Grunde auch immer, Reaktion auf Eingabe
    ' wieder einschalten
    On Error GoTo Fehler1:                          ' Fehlerbehandlung
    Set RaBereich = Range("B5:C14,E5:E7")           ' Bereich der Wirksamkeit
    ' noch mehr Bereiche
    'Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15"), _
    '    Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47"), _
    '    Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79"), _
    '    Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109"), _
    '    Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133"), _
    '    Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161"), _
    '    Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189"))
    ' nur die Zellen prüfen die im überwachten Bereich liegen
    Set RaBereich = Intersect(RaBereich, Range(Target.Address))
    'prüfen ob Zelle im Bereich geändert wurde
    If Not RaBereich Is Nothing Then
        'ActiveSheet.Unprotect "Passwort"           ' Tabellenschutz aufheben
        Application.EnableEvents = False            ' Reaktion auf Eingaben abschalten
        ' eine Schleife falls mehr als eine Zelle mit einmal ausgefüllt wurde
        ' bei einer Zelle wird die Schleife nur einmal durchlaufen
        For Each RaZelle In RaBereich
            If RaZelle <> "" Then                   ' Prüfen ob was in der Zelle steht
                If IsNumeric(RaZelle) Then          ' Prüfen ob Eingabe numerisch
                    ' feststellen wieviele Stellen vor dem Komma und soviele Nullen
                    ' auf die Variable StZahl schreiben Plus die 2 zusätzlichen Nullen
                    StZahl = String(Len(CStr(CLng(RaZelle.Value))) + 2, "0")
                    If InStr(RaZelle, ",") > 0 Then ' Prüfen ob Szellen nach Komma
                        ' Stellen nach dem Komma an StZahl anhängen
                        ' StZahl bildet die Grundlage für das Format
                        StZahl = StZahl & "." & String(Len(RaZelle) - _
                            Len(CStr(CLng(RaZelle))) - 1, "0")
                    End If
                    RaZelle.NumberFormat = StZahl   ' Zelle das neue Format zuweisen
                Else
                    ' Inhalt ist nicht numerisch, 00 nur davor
                    ' es ist keine Veränderung des Format notwendig
                    ' da der Zellinhalt Text ist
                    RaZelle = "00" & RaZelle
                End If
            End If
        Next RaZelle
    End If
Fehler1:
    Set RaBereich = Nothing
    Application.EnableEvents = True                 ' Reaktion auf Eingaben einschalten
    ' ActiveSheet.Protect "Passwort"                ' Tabellenschutz setzen
End Sub