Wieso bleibt dieses Makro teilweise in der Schleife hängen ? // Endlosschleife ...

[Sam751]

Hallo !!!

Ich habe ein Makro geschrieben, das zu bestimmten Überschriften einen Text hinzufügt. Bei den Überschriften wird nach einer bestimmten Formatierung (wdStyleHeading2) gesucht.

Das Problem ist, dass mein Makro immer an bestimmten Überschriften stehen bleibt. Es gerät in eine Endlosschleife! Die Überschriften unterscheiden sich von der Formatierung her nicht von den anderen. Auch wenn ich die Formatierung erneut erstelle bleibt das Makro trotzdem hängen. Ich benutze das .doc Format. Ich habe versucht das Dokument im neueren .docx zu speichern, allerdings bleibt mein Makro dann an einer früheren, bestimmten Stelle immer wieder hängen und geht wieder in die Endlosschleife...

Ich hab wirklich keine Ahnung mehr, woran es liegen könnte. Hier mein Makro!

Sub LinkGenerator2()
Dim dateiname As String
dateiname = ActiveDocument.Name
dateiname = Left(dateiname, Len(dateiname) - 4)
Dim wortersatz As String
Dim rng As Range
Set rng = ActiveDocument.Range
With rng.Find
  .Style = ActiveDocument.Styles(wdStyleHeading2)
  .Text = ""
  .Forward = True
  .Wrap = wdFindStop
  .Execute
  Do While .Found = True
    'packt die gefundenen gegenstände ins select
    rng.Select
    ueberschrift = rng
    

    'Liest die Länge der Überschrift und gibt sie der variable mit n buchstaben weniger (von rechts)
    ueberschrift = Left(ueberschrift, Len(ueberschrift) - 1)
    
    'selection markiert den nächsten buchstaben. da dieser überschrieben wird,
    'wird er hier in eine variable gespeichert, die später wieder mit eingefügt wird.
    Selection.Next(Count:=1).Select
    wortersatz = Selection
    
    
    'Schreibt den Text in der richtigen Formatierung
    Selection.Style = "C1H Topic Properties"
    Selection.TypeText Text:=" " & ueberschrift & "|url=" & dateiname & "." & ueberschrift & ".htm"
    
    'Ab hier wird der ersatzbuchstabe/wortersatz eingefügt. dazu wird die formatierung geändert!
    Selection.TypeText Text:=" "
    'MsgBox wortersatz
    Selection.Style = "D2HNoGloss"
    Selection.TypeText Text:=wortersatz
    'MsgBox rng
    '//
    
    .Execute
    
  Loop
  'MsgBox rng
End With
End Sub

Ich habe das Makro komplett runterkommentiert und übergeblieben ist folgendes. Es geht auch so in eine Endlosschleife:

Sub LinkGeneratorkastriert()
Set rng = ActiveDocument.Range
With rng.Find
  .Style = ActiveDocument.Styles(wdStyleHeading2)
  .Text = ""
  .Forward = True
  .Wrap = wdFindStop
  .Execute
  Do While .Found = True
     rng.Select
    .Execute
    
  Loop
End With
End Sub

Es hängt sich nur an ganz Bestimmten Überschriften auf. Diese unterscheiden sich aber, wie gesagt, nicht von den Anderen... woran liegt es ?