Hallo Leute,

ich bin dabei ein Word-Makro zu schreiben, welches folgende Funktion besitzt:

Im Dokument sind verschiedene Textmarken enthalten, welche das Dokument quasi thematisch unterteilen. Ein Thema beginnt mit einer Textmarke und endet mit der nächsten Textmarke, welche wiederum den Beginn eines neuen Themas darstellt. Das letzte Thema soll von der letzten Textmarke bis zum Ende des Dokumentes gehen. Das Marko soll das gesamte Dokument durchlaufen und alle Themen, wie gesagt beginnend mit der Textmarke, auf ein neues Blatt kopieren. Das heißt zu jeder vorhandenen Textmarke im Dokument wird ein neues Dokument erstellt und der Inhalt zwischen den Textmarken, bzw. zwischen der letzten Textmarke und dem Ende des Dokuments soll auf diese leere Seite/dieses neue Dokument kopiert, bzw. eingefügt werden. Das Ziel ist es also, für jedes Themengebiet, welche von Textmarken quasi wie Überschriften vorgegeben werden, ein einzelnes Word-Dokument zu haben.

Ich habe bereits viel versucht und es klappt sogar. Jedoch klappt es manchmal, dann teste ich es ein zweites mal ohne einen Parameter zu verändern und es klappt wieder nicht, dann fehlt einmal eine Textmarke, also eine ganze Seite, dann ist sie mal wieder da. Das Problem liegt also irgendwie an der Unregelmäßigkeit.

Vielleicht ist hier jemand ein Experte und kann mir dabei fix helfen, ich wäre auf jeden Fall sehr dankbar!

Hier mal der soweit unzuverlässige Quellcode von mir:

' ########################################################## T E X T M A R K E N #############################################################################################################################################
Dim aDoc As Word.Document
Dim x As Long, i As Long
Dim BookMarkRange As Word.Range
Set aDoc = ActiveDocument
    
If aDoc.Bookmarks.Count >= 1 Then ' Zun?chst wird gepr?ft, ob ?berhaupt Textmarken im Dokument enthalten sind
    ' Abspeichern der Textmarken in Array:
    i = 0
        ' ReDim strArray(aDoc.Bookmarks.Count, 1)
        For Each BookMarkRange In aDoc.StoryRanges
            Do While Not BookMarkRange Is Nothing
                If BookMarkRange.StoryType = wdMainTextStory Then ' Bookmarks in Fu?noten oder Kopfzeilen z?hlen nicht, nur Haupttext
                        For x = 1 To BookMarkRange.Bookmarks.Count
                            i = i + 1 
                            strArray(i) = BookMarkRange.Bookmarks(x).Name 'Name der Textmarke abspeichern
                        Next x
                End If
                Set BookMarkRange = BookMarkRange.NextStoryRange
            Loop
        Next
        
        
       For x = 1 To i
        If x <= i Then
            Dim y As String
            y = strArray(x + 1)
            ' Text zwischen zwei Textmarken markieren:
            
           ' Version 1:
            'If aDoc.Bookmarks.Exists(strArray(x)) And aDoc.Bookmarks.Exists(y) Then
            '    aDoc.Range(Start:=aDoc.Bookmarks(strArray(x)).Range.Start, _
            '       End:=aDoc.Bookmarks(y).Range.Start).Select
                   
            '
            '




            ' Version 2:
            Dim oRange As Range
            
            
           
            If aDoc.Bookmarks.Exists(strArray(x)) And aDoc.Bookmarks.Exists(y) Then
                Set oRange = aDoc.Range(Start:=aDoc.Bookmarks(strArray(x)).Range.Start, _
                            End:=aDoc.Bookmarks(y).Range.Start)
                oRange.Select
                   
                   
                   
                   
         
            Else
                MsgBox "Es ist ein Fehler aufgetreten: Die Textmarken `" & strArray(x) & "` oder `" & y & "` existieren nicht mehr."
            End If
        Else
            
          
            ' Text zwischen der letzten Textmarke und dem Blattende markieren
            aDoc.Range(Start:=aDoc.Bookmarks(strArray(x)).Range.Start, End:=aDoc.Range.End).Select
        End If
         Selection.Copy
         Dim nDoc As Word.Document
         Set nDoc = Documents.Add  ' ?ffnet neues Dokument
         Selection.Paste 'f?gt alles kopierte dort ein