Automatische Nummerierung mit Einbeziehung der aktuellen Kapitelnummer

In langen Dokumenten mit automatischer Gliederung möchte man gern innerhalb eines Kapitels eine weitere automatische Nummerierung erstellen, die die Kapitelnummer einbezieht. Dafür kann man allerdings keine eigene Gliederungsebene von Word verwenden. Einmal ist deren Anzahl auf 9 begrenzt. Zum anderen soll die Nummerierung unabhängig von der Gliederungsebene funktionieren, also jeweils im aktuellen Kapitel eine Unternummerierung darstellen. Und schließlich soll diese Nummerierung natürlich auch nicht ins automatische Inhaltsverzeichnis aufgenommen werden. Aus diesen Gründen scheidet eine eigene Gliederungsebene aus.

Automatische Nummerierung unterhalb der Gliederung

Ein StyleRef-Feld mit anschließendem Seq-Feld lässt sich dafür verwenden. Um sich das Hangeln durch die Menüs zu ersparen und trotzdem jeweils auf die aktuelle Überschrift (also die letzte vorhandene) zu verweisen, kann man mit VBA die letzte Überschrift ermitteln und beide Felder einfügen lassen. Um die Zählung des Seq-Feldes an bestimmten Stellen gezielt wieder mit 1 (oder einer anderen Startnummer) beginnen zu lassen, gibt es eine weitere kleine Prozedur.

Damit die Prozeduren auch unter Word 97 laufen, werden die Feldfunktionen versionsabhängig bestückt (in Word 97 waren die Feldnamen noch ins Deutsche übersetzt).



Sub RefNummerierungKapitel()  
' fügt eine Nummerierung (Seq-Feld) im "aktuellen" Kapitel ein  
' (das auf die "aktuelle" Überschrift verweist)  
' © Schreibbüro Richter 2008  
Dim rng As Word.Range Dim myFeld As Word.Field Dim strEbene As String Dim strNummer As String Dim strStyleref As String Dim strArabic As String
Set rng = Selection.Paragraphs(1).Range Do rng.Collapse wdCollapseStart rng.MoveStart Unit:=wdParagraph, Count:=-1 Loop Until InStr(1, rng.Paragraphs(1).Style, "Überschrift", vbTextCompare) > 0 If Val(Application.Version) < 9 Then 'In Word 97 sind die Feldfunktionen deutsch strStyleref = "FVREF" strArabic = "Arabisch" Else strStyleref = "STYLEREF" strArabic = "Arabic" End If strEbene = rng.Paragraphs(1).Style strEbene = strStyleref & " " & Chr(34) & strEbene & Chr(34) & " \n " Selection.Font.Reset Set myFeld = Selection.Fields.Add(Range:=Selection.Range, _ Type:=wdFieldEmpty, _ Text:=strEbene) strNummer = myFeld.Result If Right$(strNummer, 1) <> "." Then 'falls die Nr. nicht mit Punkt endet Selection.Collapse wdCollapseEnd Selection.TypeText "." End If Set myFeld = Selection.Fields.Add(Range:=Selection.Range, _ Type:=wdFieldEmpty, _ Text:="SEQ a\* " & strArabic & "\n ") myFeld.Update Selection.TypeText "." 'abschließender Punkt Set myFeld = Nothing Set rng = Nothing End Sub
Sub StartnummerNeuSetzen() ' setzt die Startnummer eines solchen Seq-Feldes neu ' (z. B. falls zuvor eine Überschrift eingefügt wurde)
Dim rng As Word.Range Dim strCode As String Dim intPos As Integer Dim intAnzahl As Integer Set rng = Selection.Range If rng.Fields.Count < 1 Then MsgBox "Es ist kein Feld markiert." Exit Sub End If strCode = rng.Fields(1).Code.Text intPos = InStr(1, strCode, "\n", vbBinaryCompare) If intPos > 0 Then intAnzahl = Len(strCode) strCode = Mid$(strCode, 1, intPos) & "r1" & _ Mid$(strCode, intPos + 2, intAnzahl - intPos + 2) rng.Fields(1).Code.Text = strCode ActiveDocument.Fields.Update End If Set rng = Nothing End Sub

So ordnen Sie dem Makro eine Schaltfläche auf einer Symbolleiste oder einen Shortcut zu: → Tutorial: VBA-Code für Makro einbringen und verwenden.

Schreibbüro Richter, Georg-Schumann-Str. 8, 04105 Leipzig, Tel.: (03 41) 59 008 95