Alle Textmarken in einem neuen Dokument auflisten

In alpabetischer Reihenfolge

Es werden alle Textmarken in einem Dokument in ein Array eingelesen. Anschließend wird die Auflistung in ein neu erstelltes Dokument eingefügt:

001
002
003
004
005
006
007
008
009
010
011
012
013
014
015
016
017
018
019
020
021
022
023
024
025
026
027
028
029
030
031
032
033
034
035
036
037

Sub Textmarken_listen()
     'alphabetisch sortiert
    Dim aDoc As Word.Document
    Dim nDoc As Word.Document
    Dim i As Long

    i = 0
    Set aDoc = ActiveDocument
    If aDoc.Bookmarks.Count < 1 Then
        MsgBox "kein Textmarken im Dokument enthalten!"
        Exit Sub
    End If

    ReDim strArray(aDoc.Bookmarks.Count, 1)
    Selection.HomeKey Unit:=wdStory
        For i = 1 To (aDoc.Bookmarks.Count)
            strArray(i, 0) = aDoc.Bookmarks(i).Name
            strArray(i, 1) = aDoc.Bookmarks(i).Range
        Next i

    Set nDoc = Documents.Add

    For i = 1 To (aDoc.Bookmarks.Count)
        With Selection
            .TypeText strArray(i, 0)
            .TypeText vbTab
            .TypeText vbTab
            .TypeText strArray(i, 1)
            .TypeParagraph
            .TypeParagraph
    End With
    Next i
    Set aDoc = Nothing
    Set nDoc = Nothing

End Sub

Zunächst wird geprüft, ob überhaupt Textmarken im Dokument enthalten sind (Zeile 9 bis 11). Dann wird an den Anfang des Dokuments gegangen (Zeile 15).

Anschließend werden alle Textmarken in ein Array gelesen (Zeile 16 bis 19), in Zeile 21 ein neues Dokument erstellt und in Zeile 23 bis 31 das Array in das neue Dokument eingefügt.

In Zeile 33 bis 34 werden die Objekte für die Dokumente wieder entladen.

In der Reihenfolge des Vorkommens im Dokument

Hier werden auch alle Textmarken des aktuellen Dokuments in einem neuen Dokument aufgelistet. Allerdings in der Reihenfolge, wie sie im ursprünglichen Dokument auftreten. Ausgelesen werden nicht die Textmarken in der Kopf- und Fußzeile (dazu müsste der Code noch egänzt werden).

001
002
003
004
005
006
007
008
009
010
011
012
013
014
015
016
017
018
019
020
021
022
023
024
025
026
027
028
029
030
031
032
033
034
035
036
037
038
039
040
041

Sub Textmarken_listen_Reihenfolge()
     'nach Reihenfolge im Doku sortiert
     'ohne Kopf- und Fußzeile
    Dim aDoc As Word.Document
    Dim nDoc As Word.Document
    Dim x As Long, i As Long
    Dim MyRange As Word.Range

    Set aDoc = ActiveDocument
    If aDoc.Bookmarks.Count < 1 Then
        MsgBox "kein Textmarken im Dokument enthalten!"
        Exit Sub
    End If
    i = 0
    ReDim strArray(aDoc.Bookmarks.Count, 1)
    For Each MyRange In aDoc.StoryRanges
      Do While Not MyRange Is Nothing
        If MyRange.StoryType = wdMainTextStory Then
            For x = 1 To MyRange.Bookmarks.Count
            i = i + 1
             strArray(i, 0) = MyRange.Bookmarks(x).Name
             strArray(i, 1) = MyRange.Bookmarks(x).Range
            Next x
        End If
        Set MyRange = MyRange.NextStoryRange
      Loop
    Next

    Set nDoc = Documents.Add
    For x = 1 To i
        Selection.TypeText strArray(x, 0) & vbTab & vbTab
        Selection.TypeText strArray(x, 1)
        Selection.TypeParagraph
        Selection.TypeParagraph
    Next

    Set nDoc = Nothing
    Set aDoc = Nothing

End Sub

Durch die Unterteilung des Dokumentes in Rangeobjekte ist es hier möglich, die Textmarken aus ihrer ursprünglichen Stelle im Dokument einzulesen. Dadurch ändert sich die Reihenfolge bei der Ausgabe.

Sonst entspricht der Code der weiter Variante für das Einfügen in alphabetischer Reihenfolge.

zurück zur Übersicht Textmarken