 |
|
 |
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
|
 |
