Private Sub Text1_Click()
 
Dim ST                                              'Suchtext nach Klick
Dim LZ As String, RZ As String, Wort As String      'linkes und rechtes 
' Leerzeichen und das geklickte Wort
Dim i As Integer, a As Integer                      'i und a zum Hochzählen (in 
' Schleifen)
Dim L As Long
i = 0
a = 0
L = Len(Text1.Text)
 
If Text1.Text <> "" Then 'Damit überhaupt erst mal ein Text mit Klick 
' eingefügt werden kann
 
    Do Until LZ = " " Or i = 100 'sonst Überlauffehler beim ersten Wort
        i = i + 1
        LZ = Left(Right(Text1.Text, L - Text1.SelStart + i), 1)
    Loop
 
        ST = Right(Right(Text1.Text, L - Text1.SelStart + i), Len(Right( _
          Text1.Text, L - Text1.SelStart + i)) - 1)
 
    Do Until RZ = " " Or a = 200 'sonst Überlauffehler beim letzten Wort
        a = a + 1
        RZ = Right(Left(ST, a), 1)
    Loop
        Wort = Left(ST, a - 1)  'das letzte Zeichen (Leerzeichen) entfernen  a 
        ' - 1
 
        'Satzzeichen, die dem Wort evtl angehängt sind, herausfiltern
        If Right(Wort, 1) = "." Or Right(Wort, 1) = "," Or Right(Wort, 1) = ":" _
          Or Right(Wort, 1) = ")" _
                Or Right(Wort, 1) = ";" Or Right(Wort, 1) = "!" Or Right(Wort, _
                1) = "?" _
                Or Right(Wort, 1) = "'" Or Right(Wort, 1) = "-" Or Right(Wort, _
                1) = "_" Then
            Wort = Left(Wort, Len(Wort) - 1)
        Else
            Wort = Wort
        End If
 
        'Satzzeichen, die dem Wort evtl vorangestellt sind, herausfiltern
        If Left(Wort, 1) = "(" Or Left(Wort, 1) = "-" Or Left(Wort, 1) = "'" _
          Then
            Wort = Right(Wort, Len(Wort) - 1)
        Else
            Wort = Wort
        End If
 
        'Leerzeilen eleminieren
        If Left(Wort, 2) = vbNewLine Or Left(Wort, 2) = vbCrLf Then
            Dim z As Integer
            Dim W As String
            W = Wort
            Do Until Left(W, 2) <> vbNewLine Or Left(W, 2) <> vbCrLf
                z = z + 2
                    If Left(W, 2) = vbCrLf Or Left(W, 2) = vbNewLine Then
                        W = Right(Wort, Len(Wort) - z)
                    End If
            Loop
            Wort = W
        End If
 
        If i = 100 Then 'wenn i = 200 fehlt beim ersten Wort der erste 
        ' Buchstabe, der wird hier wieder angehängt
            Combo1.AddItem Left(Text1.Text, 1) & Wort
        Else
            Combo1.AddItem Wort
        End If
 
End If
 
End Sub