Attribute VB_Name = "modColorMarker"
Option Explicit

' Öffnet das Auswahl-Formular. Über Alt+F8 aus jeder Arbeitsmappe startbar.
Public Sub ShowColorMarker()
    If TypeName(ActiveSheet) <> "Worksheet" Then
        MsgBox "Bitte zuerst ein normales Tabellenblatt aktivieren.", vbExclamation
        Exit Sub
    End If
    frmMarker.Show
End Sub

' Liefert alle eindeutigen, nicht leeren Texte aus Spalte 3 des aktiven Blatts.
Public Function GetUniqueValuesSpalte3() As Collection
    Dim col As New Collection
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim v As String
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row
    For i = 1 To lastRow
        v = Trim(CStr(ws.Cells(i, 3).Value))
        If v <> "" Then
            On Error Resume Next
            col.Add v, v
            On Error GoTo 0
        End If
    Next i
    Set GetUniqueValuesSpalte3 = col
End Function

' Färbt alle Zellen in Spalte 3 des aktiven Blatts ein, deren Inhalt in 'texte' vorkommt.
Public Sub FarbeAufSpalte3Anwenden(ByVal texte As Collection, ByVal farbe As Long)
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim v As String, t As Variant
    Dim treffer As Boolean
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row
    For i = 1 To lastRow
        v = Trim(CStr(ws.Cells(i, 3).Value))
        treffer = False
        For Each t In texte
            If v = t Then
                treffer = True
                Exit For
            End If
        Next t
        If treffer Then ws.Cells(i, 3).Interior.Color = farbe
    Next i
End Sub

' Entfernt die Füllfarbe nur von Zellen, deren Inhalt in 'texte' vorkommt.
Public Sub FarbeVonSpalte3Entfernen(ByVal texte As Collection)
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim v As String, t As Variant
    Dim treffer As Boolean
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row
    For i = 1 To lastRow
        v = Trim(CStr(ws.Cells(i, 3).Value))
        treffer = False
        For Each t In texte
            If v = t Then
                treffer = True
                Exit For
            End If
        Next t
        If treffer Then ws.Cells(i, 3).Interior.ColorIndex = xlNone
    Next i
End Sub

' Entfernt jede Füllfarbe aus Spalte 3 des aktiven Blatts.
Public Sub AlleFarbenSpalte3Entfernen()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row
    For i = 1 To lastRow
        ws.Cells(i, 3).Interior.ColorIndex = xlNone
    Next i
End Sub

' Ersetzt Zeichen, die in Registry-Abschnittsnamen unzulässig sind, durch '_'.
Public Function SanitizeVorlagenName(ByVal name As String) As String
    Dim erg As String
    Dim i As Long
    Dim c As String
    erg = ""
    For i = 1 To Len(name)
        c = Mid(name, i, 1)
        If InStr("\/:*?" & Chr(34) & "<>|", c) > 0 Then
            erg = erg & "_"
        Else
            erg = erg & c
        End If
    Next i
    SanitizeVorlagenName = erg
End Function

' Liefert die Namen aller gespeicherten Vorlagen.
Public Function VorlagenListeLaden() As Collection
    Dim ergebnis As New Collection
    Dim liste As String
    Dim teile() As String
    Dim j As Long
    liste = GetSetting("ColorMarkerTool", "Verwaltung", "VorlagenListe", "")
    If liste <> "" Then
        teile = Split(liste, "||")
        For j = LBound(teile) To UBound(teile)
            If Trim(teile(j)) <> "" Then ergebnis.Add teile(j)
        Next j
    End If
    Set VorlagenListeLaden = ergebnis
End Function

' Speichert 'zuordnungen' dauerhaft unter dem angegebenen Vorlagen-Namen.
Public Sub VorlageSpeichernAls(ByVal name As String, ByVal zuordnungen As Collection)
    Dim liste As Collection
    Dim n As Variant
    Dim namenStr As String
    Dim gefunden As Boolean
    Dim sektion As String
    Dim e As Variant, t As Variant
    Dim i As Long
    Dim texteStr As String
    sektion = "Vorlage_" & SanitizeVorlagenName(name)
    SaveSetting "ColorMarkerTool", sektion, "AnzahlGruppen", CStr(zuordnungen.Count)
    i = 0
    For Each e In zuordnungen
        i = i + 1
        SaveSetting "ColorMarkerTool", sektion, "Farbe" & i, CStr(e(0))
        texteStr = ""
        For Each t In e(1)
            If texteStr <> "" Then texteStr = texteStr & "||"
            texteStr = texteStr & t
        Next t
        SaveSetting "ColorMarkerTool", sektion, "Texte" & i, texteStr
    Next e
    Set liste = VorlagenListeLaden()
    gefunden = False
    namenStr = ""
    For Each n In liste
        If namenStr <> "" Then namenStr = namenStr & "||"
        namenStr = namenStr & n
        If n = name Then gefunden = True
    Next n
    If Not gefunden Then
        If namenStr <> "" Then namenStr = namenStr & "||"
        namenStr = namenStr & name
    End If
    SaveSetting "ColorMarkerTool", "Verwaltung", "VorlagenListe", namenStr
End Sub

' Lädt die unter 'name' gespeicherte Vorlage.
Public Function VorlageLaden(ByVal name As String) As Collection
    Dim ergebnis As New Collection
    Dim sektion As String
    Dim anzahl As Long, i As Long, j As Long
    Dim farbe As Long
    Dim texteStr As String
    Dim teile() As String
    Dim texte As Collection
    Dim eintrag(1) As Variant
    sektion = "Vorlage_" & SanitizeVorlagenName(name)
    anzahl = Val(GetSetting("ColorMarkerTool", sektion, "AnzahlGruppen", "0"))
    For i = 1 To anzahl
        farbe = Val(GetSetting("ColorMarkerTool", sektion, "Farbe" & i, ""))
        texteStr = GetSetting("ColorMarkerTool", sektion, "Texte" & i, "")
        If texteStr <> "" Then
            teile = Split(texteStr, "||")
            Set texte = New Collection
            For j = LBound(teile) To UBound(teile)
                texte.Add teile(j)
            Next j
            eintrag(0) = farbe
            Set eintrag(1) = texte
            ergebnis.Add eintrag
        End If
    Next i
    Set VorlageLaden = ergebnis
End Function

' Löscht die unter 'name' gespeicherte Vorlage wieder.
Public Sub VorlageLoeschen(ByVal name As String)
    Dim liste As Collection
    Dim n As Variant
    Dim namenStr As String
    On Error Resume Next
    DeleteSetting "ColorMarkerTool", "Vorlage_" & SanitizeVorlagenName(name)
    On Error GoTo 0
    Set liste = VorlagenListeLaden()
    namenStr = ""
    For Each n In liste
        If n <> name Then
            If namenStr <> "" Then namenStr = namenStr & "||"
            namenStr = namenStr & n
        End If
    Next n
    SaveSetting "ColorMarkerTool", "Verwaltung", "VorlagenListe", namenStr
End Sub