Textmarkenübersicht

Wer viel mit Textmarken arbeitet kennt den umständlichen Weg, jedesmal über das Menü den Punkt Textmarken auszuwählen, um zu einer bestimmten Textmarke springen zu können. Alternativ kann man sich für diesen Menüpunkt auch ein Tastenkürzel definieren, das dann dieses Dialogfenster öffnet.
Mit folgenden Makros werden alle Textmarken mit ihrem Namen in eine Auswahlliste geschrieben und können durch Auswahl in dieser Liste direkt im Text angesprungen werden. Insgesamt werden vier Makros verwendet, wobei zwei nur die Aufgabe haben eine zusätzliche Symbolleiste anzulegen (

TMarkMenue) und ggf. wieder zu löschen (

TMMenueloeschen). In die Symbolleiste wird, sofern noch nicht vorhanden, die Schaltfläche/Auswahlliste eingefügt und die Verknüpfung mit den Makros hergestellt.

Die Suche und Auflistung aller Textmarken erfolgt innerhalb des Makros

Textmarkensuchen.
In einer Schleife werden dazu alle Textmarken durchlaufen und in die Auswahlliste mit dem vergebenen Namen eingetragen. Die Funktion

TMarkAuswahl markiert die in der Auswahlliste ausgewählte Textmarke, so dass schnell zwischen den verschiedenen Textmarken im Dokument gewechselt werden kann.

Das temporäre Anlegen der Symbolleisten sorgt dafür, dass beim Beenden die Symbolleiste automatisch wieder gelöscht wird und keine Nachfrage zu Speichern angezeigt wird. Soll die Symbolleiste dauerhaft angezeigt und mitgespeichert werden, muss die Konstante temporary auf True gesetzt werden.

Option Explicit 
Dim cbar1 As CommandBar
Dim cbar1cb As CommandBarComboBox
Dim cbar1btn As CommandBarButton

Sub TMarkMenue()   
Dim bfound As Boolean 
' Symbolleiste suchen und ggf. temporär anlegen   
For Each cbar1 In CommandBars
  If cbar1.Name = "MeineTextmarken" Then 
    Set cbar1 = CommandBars("MeineTextmarken")
    bfound = True 
    Exit For 
  End If 
Next cbar1
If Not bfound Then 
  Set cbar1 = CommandBars.Add(Name:="MeineTextmarken",  _
     Position:=msoBarTop, temporary:=True)
End If 
cbar1.Visible = True 
' Schaltlfäche hinzufügen   
Set cbar1btn = CommandBars("MeineTextmarken").FindControl( _
    Type:=msoControlButton, _
    ID:=CommandBars("Standard").Controls("Seitenansicht").ID)
If cbar1btn Is Nothing Then 
  Set cbar1btn = cbar1.Controls.Add(Type:=msoControlButton,  _
    ID:=CommandBars("Standard").Controls("Seitenansicht").ID, temporary:=True)
  cbar1btn.TooltipText = "Textmarken listen"
End If 
cbar1btn.OnAction = "Textmarkensuchen"
' Auswahlliste hinzufügen   
Set cbar1cb = CommandBars("MeineTextmarken").FindControl( _
   Type:=msoControlComboBox, ID:=1)
If cbar1cb Is Nothing Then 
  Set cbar1cb = cbar1.Controls.Add(Type:=msoControlComboBox,  _
     ID:=1, temporary:=True)
  cbar1cb.TooltipText = "Textmarke anzeigen"
  cbar1cb.Width = 150
End If 
cbar1cb.OnAction = "TMarkAuswahl"
End Sub 

Sub TMMenueloeschen()   
Set cbar1btn = CommandBars("MeineTextmarken").FindControl( _
    Type:=msoControlButton, _
    ID:=CommandBars("Standard").Controls("Seitenansicht").ID)
cbar1btn.Delete
Set cbar1cb = CommandBars("meineTextmarken").FindControl( _
   Type:=msoControlComboBox, ID:=1)
cbar1cb.Delete
CommandBars("meineTextmarken").Delete
Set cbar1btn = Nothing 
Set cbar1cb = Nothing 
Set cbar1 = Nothing 
End Sub 

Sub Textmarkensuchen()   
Dim i, j As Integer
Dim sTMLaenge As Integer
Dim sTMark As Bookmark
Dim rngTMark As Range
Dim rngDoc As Range
If Application.Documents.Count = 0 Then Exit Sub 
i = 0: j = 0
sTMLaenge = 0
TMarkMenue
Set cbar1cb = CommandBars("MeineTextmarken").FindControl( _
   Type:=msoControlComboBox, ID:=1)
cbar1cb.Clear
ActiveDocument.ActiveWindow.View.ShowFieldCodes = Fals
Set rngDoc = ActiveDocument.Range
rngDoc.WholeStory
For Each sTMark In rngDoc.Bookmarks
  Set rngTMark = sTMark.Range
  cbar1cb.AddItem sTMark.Name
If Len(sTMark.Name) > sTMLaenge Then sTMLaenge = Len( _
  (sTMark.Name)
i = i + 1
Next sTMark
If Not i = 0 Then cbar1cb.ListIndex = 1
cbar1cb.Width = sTMLaenge * 6.5 + 5
End Sub 

Function TMarkAuswahl()   
Dim gefunde  As Boolean 
Set cbar1cb = CommandBars("MeineTextmarken").FindControl( _
   Type:=msoControlComboBox,ID:=1)
With cbar1cb
  ActiveDocument.Bookmarks(.ListIndex).Select
End With 
'weiter:   
End Function