VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmMarker 
   Caption         =   "UserForm1"
   ClientHeight    =   7905
   ClientLeft      =   120
   ClientTop       =   465
   ClientWidth     =   7110
   OleObjectBlob   =   "frmMarker.frx":0000
   StartUpPosition =   1  'Fenstermitte
End
Attribute VB_Name = "frmMarker"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private mZuordnungen As Collection
Private mAktuelleFarbe As Long
Private mFarbeGewaehlt As Boolean

Private Sub UserForm_Initialize()
    Dim col As Collection, v As Variant
    Dim arr() As String
    Dim i As Long, j As Long
    Dim tmp As String
    Set mZuordnungen = New Collection
    mFarbeGewaehlt = False
    Me.lstTexte.Clear
    Me.lstZuordnungen.Clear
    Set col = GetUniqueValuesSpalte3()
    If col.Count > 0 Then
        ReDim arr(1 To col.Count)
        i = 0
        For Each v In col
            i = i + 1
            arr(i) = v
        Next v
        For i = 1 To UBound(arr) - 1
            For j = i + 1 To UBound(arr)
                If StrComp(arr(i), arr(j), vbTextCompare) > 0 Then
                    tmp = arr(i)
                    arr(i) = arr(j)
                    arr(j) = tmp
                End If
            Next j
        Next i
        For i = 1 To UBound(arr)
            Me.lstTexte.AddItem arr(i)
        Next i
    End If
    If Me.lstTexte.ListCount = 0 Then
        MsgBox "In Spalte 3 des aktiven Blatts wurden keine Texte gefunden.", vbInformation
    End If
    RefreshVorlagenListe
End Sub

Private Sub RefreshVorlagenListe()
    Dim namen As Collection, n As Variant
    Dim arr() As String
    Dim i As Long, j As Long
    Dim tmp As String
    Me.lstVorlagen.Clear
    Set namen = VorlagenListeLaden()
    If namen.Count = 0 Then Exit Sub
    ReDim arr(1 To namen.Count)
    i = 0
    For Each n In namen
        i = i + 1
        arr(i) = n
    Next n
    For i = 1 To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If StrComp(arr(i), arr(j), vbTextCompare) > 0 Then
                tmp = arr(i)
                arr(i) = arr(j)
                arr(j) = tmp
            End If
        Next j
    Next i
    For i = 1 To UBound(arr)
        Me.lstVorlagen.AddItem arr(i)
    Next i
End Sub

Private Sub btnFarbeWaehlen_Click()
    Dim ok As Boolean
    ok = Application.Dialogs(xlDialogEditColor).Show(56, RGB(255, 0, 0))
    If ok Then
        mAktuelleFarbe = ActiveWorkbook.Colors(56)
        mFarbeGewaehlt = True
        Me.lblFarbVorschau.BackColor = mAktuelleFarbe
    End If
End Sub

Private Sub btnHinzufuegen_Click()
    Dim i As Integer
    Dim gewaehlt As New Collection
    If Not mFarbeGewaehlt Then
        MsgBox "Bitte zuerst eine Farbe wählen.", vbExclamation
        Exit Sub
    End If
    For i = 0 To Me.lstTexte.ListCount - 1
        If Me.lstTexte.Selected(i) Then gewaehlt.Add Me.lstTexte.List(i)
    Next i
    If gewaehlt.Count = 0 Then
        MsgBox "Bitte mindestens einen Text auswählen.", vbExclamation
        Exit Sub
    End If
    Dim eintrag(1) As Variant
    eintrag(0) = mAktuelleFarbe
    Set eintrag(1) = gewaehlt
    mZuordnungen.Add eintrag
    Dim liste As String, t As Variant
    For Each t In gewaehlt
        If liste <> "" Then liste = liste & ", "
        liste = liste & t
    Next t
    Me.lstZuordnungen.AddItem liste & "  ->  Farbe #" & mZuordnungen.Count
    mFarbeGewaehlt = False
    Me.lblFarbVorschau.BackColor = &HFFFFFF
End Sub

Private Sub btnEntfernen_Click()
    Dim idx As Integer
    Dim eintrag As Variant
    idx = Me.lstZuordnungen.ListIndex
    If idx = -1 Then Exit Sub
    eintrag = mZuordnungen(idx + 1)
    FarbeVonSpalte3Entfernen eintrag(1)
    mZuordnungen.Remove idx + 1
    Me.lstZuordnungen.RemoveItem idx
End Sub

Private Sub btnFarbenLoeschen_Click()
    If MsgBox("Wirklich alle Füllfarben in Spalte 3 des aktiven Blatts entfernen?", _
        vbYesNo + vbQuestion) = vbYes Then
        AlleFarbenSpalte3Entfernen
    End If
End Sub

Private Sub btnAnwenden_Click()
    Dim e As Variant
    If mZuordnungen.Count = 0 Then
        MsgBox "Es wurden noch keine Zuordnungen hinzugefügt.", vbExclamation
        Exit Sub
    End If
    For Each e In mZuordnungen
        FarbeAufSpalte3Anwenden e(1), e(0)
    Next e
    MsgBox "Markierung angewendet.", vbInformation
End Sub

Private Sub btnVorlageSpeichernAls_Click()
    Dim name As String
    Dim vorschlag As String
    If mZuordnungen.Count = 0 Then
        MsgBox "Es gibt keine Zuordnungen zum Speichern.", vbExclamation
        Exit Sub
    End If
    If Me.lstVorlagen.ListIndex <> -1 Then
        vorschlag = Me.lstVorlagen.List(Me.lstVorlagen.ListIndex)
    End If
    name = InputBox("Name für diese Vorlage:", "Vorlage speichern", vorschlag)
    name = Trim(name)
    If name = "" Then Exit Sub
    If Ueberschreiben(name) Then
        VorlageSpeichernAls name, mZuordnungen
        RefreshVorlagenListe
        MsgBox "Vorlage '" & name & "' gespeichert.", vbInformation
    End If
End Sub

Private Function Ueberschreiben(ByVal name As String) As Boolean
    Dim i As Integer
    Dim vorhanden As Boolean
    vorhanden = False
    For i = 0 To Me.lstVorlagen.ListCount - 1
        If Me.lstVorlagen.List(i) = name Then vorhanden = True
    Next i
    If vorhanden Then
        Ueberschreiben = (MsgBox("Vorlage '" & name & "' existiert bereits. Überschreiben?", vbYesNo + vbQuestion) = vbYes)
    Else
        Ueberschreiben = True
    End If
End Function

Private Sub btnVorlageLaden_Click()
    Dim idx As Integer
    Dim name As String
    Dim geladen As Collection, e As Variant, t As Variant, liste As String
    idx = Me.lstVorlagen.ListIndex
    If idx = -1 Then
        MsgBox "Bitte zuerst eine Vorlage in der Liste auswählen.", vbExclamation
        Exit Sub
    End If
    name = Me.lstVorlagen.List(idx)
    If mZuordnungen.Count > 0 Then
        If MsgBox("Die aktuellen Zuordnungen werden durch die Vorlage '" & name & "' ersetzt. Fortfahren?", vbYesNo + vbQuestion) <> vbYes Then
            Exit Sub
        End If
    End If
    Set geladen = VorlageLaden(name)
    Set mZuordnungen = New Collection
    Me.lstZuordnungen.Clear
    For Each e In geladen
        mZuordnungen.Add e
        liste = ""
        For Each t In e(1)
            If liste <> "" Then liste = liste & ", "
            liste = liste & t
        Next t
        Me.lstZuordnungen.AddItem liste & "  ->  Farbe #" & mZuordnungen.Count
    Next e
End Sub

Private Sub btnVorlageLoeschen_Click()
    Dim idx As Integer
    Dim name As String
    idx = Me.lstVorlagen.ListIndex
    If idx = -1 Then
        MsgBox "Bitte zuerst eine Vorlage in der Liste auswählen.", vbExclamation
        Exit Sub
    End If
    name = Me.lstVorlagen.List(idx)
    If MsgBox("Vorlage '" & name & "' wirklich löschen?", vbYesNo + vbQuestion) = vbYes Then
        VorlageLoeschen name
        RefreshVorlagenListe
    End If
End Sub

Private Sub btnSchliessen_Click()
    Unload Me
End Sub