Wörter verbinden

Option Explicit
Type myWords_Structure
  l_anf As Long
  l_end As Long
End Type

Sub Selektion_WorteGrossUndBindestrich()
 ->Umwandlung von maximal 3 selektierte Worte
 ->Wort-Anfang wird jeweils groß geschrieben
 ->Leerzeichen zwischen den Worten werden
 ->durch einen Bindestrich ersetzt
  
  
  Dim doc As Document, l_anf As Long, l_end As Long
  Dim w As Long, x As Long
  Dim mywords(1 To 3) As myWords_Structure, l_AnzWords As Long
  
  Set doc = ActiveDocument
  l_anf = Selection.Start
  l_end = Selection.End
  l_AnzWords = Selection.Words.Count
  
  If Selection.Paragraphs.Count > 1 Then
    MsgBox (Selektion darf nicht über die Absatzgrenze erfolgen.)
    GoTo Aufraeumen
  End If
  If l_AnzWords > 3 Then
    MsgBox (Es dürfen maximal 3 Worte selektiert werden.)
    GoTo Aufraeumen
  End If
  If l_AnzWords < 2 Then
    MsgBox (Es müssen minimal 2 Worte selektiert werden.)
    GoTo Aufraeumen
  End If
  
 ->reine Worte ohne Leerzeichen - Anfang/Ende bestimmen
  For w = 1 To l_AnzWords
    doc.Range(Start:=l_anf, End:=l_end).Words(w).Select
    mywords(w).l_anf = Selection.Start
    mywords(w).l_end = Selection.End
    For x = mywords(w).l_end To mywords(w).l_anf + 1 Step -1
      If doc.Range(Start:=x - 1, End:=x).Text <>   Then Exit For
      mywords(w).l_end = x - 1
    Next
  Next

 ->jeweils erstes Zeichen der Worte groß
  For x = 1 To l_AnzWords
    doc.Range(Start:=mywords(x).l_anf, End:=mywords(x).l_anf + 1).Text = _
      UCase(doc.Range(Start:=mywords(x).l_anf, End:=mywords(x).l_anf + 1).Text)
  Next
  
 ->Leerzeichen zwischen den Worten durch Bindestrich ersetzen
  For x = l_AnzWords To 2 Step -1
    doc.Range(Start:=mywords(x - 1).l_end, End:=mywords(x).l_anf).Text = -
  Next
Aufraeumen:
  Set doc = Nothing
End Sub