Multiple Indices

Eigentlich habe ich hinten und vorne keine Zeit, um einen Blogeintrag zu verfassen. Deshalb hier etwas “aus der Konserve”: Kürzlich musste ich folgendes Problem lösen. Ein Freund wollte in MS Word mehrere separate Verzeichnisse (z.B. Ortsverzeichnis, Personenverzeichnis, Sachverzeichnis). Word bietet dazu einen absolut “unmöglichen” Dialog dazu an. Diesen kann man niemand zumuten! Word bietet hingegen auch eine sehr mächtige Suchen-und-Ersetzen-Funktion an. Könnte man damit nicht…? Eine Idee war geboren!

Na klar, man kann: Ein paar Makros aufzeichnen, danach in ein schönes VBA-Skript vergossen, erhält man eine sehr komfortable Funktion für multiple Indices. Die Einträge werden verschiedenfarblich markiert, danach das VBA-Skript gestartet und fertig ist die Sache. Hier der Code:

Sub MultipleIndices() 

'Makro zur Erstellung von mehrere (z.Z. 3) Indices 
'Die Einträge müssen farblich markiert sein 

 

'Farbdefinitionen 
'**************** 

Const wdRot = wdColorRed
Const wdTurkis = 3
Const wdGelb = 6
Const wdKeinhighlight = 0 

'zugehörige Indextypen 
'********************* 

Const TypRot = "Ortsverzeichnis"
Const TypTurkis = "Personenverzeichnis"
Const TypGelb = "Sachverzeichnis" 

'Word-Dokument 
'************* 

Const Pfad = "H:\VBA\"
Const Datei = "Lorem"
Const Endung = ".docx" 

'Variablen 
'********* 

Dim Eintrag     As String
Dim AnzRot      As Integer
Dim AnzTurkis   As Integer
Dim AnzGelb     As Integer 

'Öffnen des Dokumentes 
'********************* 
'
'Set objWord = CreateObject("Word.Application") 
'objWord.Visible = True 
'Set objDoc = objWord.Documents.Open(Pfad & Datei & Endung) 
'Set objRange = objDoc.Range

 

'Suchen der Markierten Wörter 
'**************************** 

objRange.Find.Highlight = True
objRange.Find.Forward = True
AnzRot = 0
AnzTurkis = 0
AnzGelb = 0 

Do While objRange.Find.Execute
    If objRange.HighlightColorIndex = wdRot Then
        objRange.HighlightColorIndex = wdKeinhighlight
        Eintrag = objRange
        objDoc.Indexes.MarkEntry Range:=objRange, Entry:= _
            TypRot & ":" & Eintrag, EntryAutoText:=TypRot & ":" & Eintrag, _
            CrossReference:="", CrossReferenceAutoText:="", BookmarkName:="", Bold:= _
            False, Italic:=False
        AnzTurkis = AnzRot + 1
    End If 
    intPosition = objRange.End
    objRange.Start = intPosition
Loop 

Do While objRange.Find.Execute
    If objRange.HighlightColorIndex = wdTurkis Then
        objRange.HighlightColorIndex = wdKeinhighlight
        Eintrag = objRange
        objDoc.Indexes.MarkEntry Range:=objRange, Entry:= _
            TypTurkis & ":" & Eintrag, EntryAutoText:=TypTurkis & ":" & Eintrag, _
            CrossReference:="", CrossReferenceAutoText:="", BookmarkName:="", Bold:= _
            False, Italic:=False
        AnzTurkis = AnzTurkis + 1
    End If 
    intPosition = objRange.End
    objRange.Start = intPosition
Loop 

Do While objRange.Find.Execute
    If objRange.HighlightColorIndex = wdGelb Then
        objRange.HighlightColorIndex = wdKeinhighlight
        Eintrag = objRange
        objDoc.Indexes.MarkEntry Range:=objRange, Entry:= _
            TypGelb & ":" & Eintrag, EntryAutoText:=TypGelb & ":" & Eintrag, _
            CrossReference:="", CrossReferenceAutoText:="", BookmarkName:="", Bold:= _
            False, Italic:=False
        AnzTurkis = AnzGelb + 1
    End If 
    intPosition = objRange.End
    objRange.Start = intPosition
Loop 

'Ausgabebox mit Informationen 
'**************************** 

MsgBox Prompt:="Es wurden " & AnzTurkis & " Einträge ins Personenverzeichnis, " & _
   AnzRot & " Einträge ins Ortsverzeichnis und " & AnzGelb & _
   " Einträge ins Sachverzeichnis eingefügt.", Title:="LugraSkript", _
   Buttons:=vbInformation 

 

'Speichern und schliessen 
'************************ 
'
'objDoc.SaveAs FileName:=Pfad & Datei & "mitIndices" & Endung 
'objDoc.Close 

End Sub 

Mit VBA stehe ich übrigens auf Kriegsfuss. So musste ich beispielsweise ein Forum um Hilfe bitten, denn VBA hat ungefähr fünftausend Funktionen zu viel. Noch immer ungelöst ist die Sache mit den Farbdefinitionen. Scheinbar sind die je nach Word-Version unterschiedlich vordefiniert. So wollte ich die RGB-Koordinaten angeben, aber das funktioniert nicht. Der Anwender muss also herumpröbeln und -pfuschen (z.B. Teile im Skript deaktivieren, danach Farben per Suchen-und-Ersetzen-Dialog im Text umdefinieren), bis es klappt. Falls mir da jemand einen Tipp hätte, dürft Ihr Euch gerne melden.

Die Funktionen zum Öffnen und Speichern der Datei sind auskommentiert, da ziemlich überflüssig: Man kann das VBA einfach in das zu bearbeitende Dokument kopieren, dann braucht man nichts zu öffnen und speichern.

Für mich hat das Skript seinen Zweck erfüllt und für ein 500-seitiges Buch Indices mit über 3000 Einträgen generiert. Trotzdem liesse sich natürlich noch einiges daran verbessern. Ein grafisches Benutzerfeld habe ich zu Beginn vorgesehen, später aber fallen gelassen. Fühlt Euch frei, das Skript zu verwenden und zu verbessern. Wenn Ihr möchtet, könnt Ihr mir natürlich Vorschläge per E-Mail schicken. Oder noch besser, gleich im entsprechenden Forum: www.office-loesung.de

 

Leave a Reply