automatisches Inhaltsverzeichnis erstellen

[Dietmar Henning]

Hallo Zusammen,

Ich habe eine Frage zu den Inhaltsverzeichnissen in Word.
Im Anhang findet Ihr eine Beispiel-Word-Datei wie meine Text aufgebaut sind.
 
Ich habe meine jeweiligen Überschriften die jeweiligen Formatvorlagen zugewiesen und somit konnte ich ein Inhaltsverzeichnis über 3 Level erstellen.
 
Formatvorlage Part_Überschrift-> ist in der Zeile Part A Seife und Part B Topf
Formatvorlage Positionsüberschrift -> ist in der Zeile cvx()       1        Schaum
Formatvorlage Preis ist in der Zeile -> Zum Preis von EUR  zys(-)
Ich würde jetzt aber gerne, dass beim automatischen Erstellen eines Inhaltsverzeichnisses, der Inhalt von Level 3 neben Level 2 steht.
 
So sollte es aussehen:
 
Part A Seife
cvx 1 Schaum      zum Preis von EUR zys(-)
Part B Topf
cvx 1 Schaum      zum Preis von EUR zys(-)
 
Ist das möglich, dass man so etwas automatisch machen kann in Word?

Danke schonmal für die Hilfe.

[Gerhard H]

Hallo Dietmar,

so richtig automatisch wirds nicht gehen. Aber das folgende Makro  baut dein bereits existierendes IHV nachträglich um. Das bedeutet, dass du das Makro auf das Originaldokument erst dann loslässt, wenn keine Änderungen mehr gemacht werden müssen.

Code:

Sub dritteEbeneNachRechts()
Dim ihvBereich As Range
Dim anzAbsaetze As Long

'Absätze des IHV zählen
Set ihvBereich = ActiveDocument.TablesOfContents(1).Range
anzAbsaetze = ihvBereich.Paragraphs.Count

    'Schleife über alle Absätze des Inhaltsverzeichnisses
    For i = anzAbsaetze To 1 Step -1
        With ihvBereich
            'wenn ein Absatz mit 'Verzeichnis 2" formatiert ist...
            If .Paragraphs(i).Style = "Verzeichnis 2" Then
                '...ersetze die Absatzmarke durch drei Leerzeichen (oder sonstwas)
                .Paragraphs(i).Range.Characters.Last = "   "
            End If
        End With
    Next i
End Sub

Ich bin übrigens selbst sehr erstaunt, dass das IHV dabei nicht zerstört wird. Also teste es ausgiebig. Du solltest dazu an deinem Musterdokument zwei Änderungen vornehmen:

• Die jeweils 3 Tabulatoren zwischen "Zum Preis von" und den Euros durch nur einen ersetzen und dafür die Tabulatorenweite entsprechend angepassen (ansonsten erscheinen im umgebauten Inhaltsverzeichnis unpassende Tabstopps).
  
• Die einzelnen Inhaltsverzeichnis-Einträge unterscheidbar machen, damit du kontrollieren kanns, ob die Reihenfolge passt. Z.B. durch Einfügen von Zahlen in deine cvx- und zys-Klammern.
  

[Dietmar Henning]

Hallo Gerhard,

das ist ja der Wahnsinn.
Danke das du mir hilfst. 
Ich hätte noch eine Frage an dich.
Ist es auch möglich, dass er den Text "Zum Preis von" ersetzt durch Leerzeichen bzw. entfernt werden kann wenn das Inhaltsverzeichnis erstellt wird? 

Jetzt sieht es so aus wenn ich deine Makro mit meiner kombiniere:

Part A Seife
cvx()                            1 Schaum         Zum Preis von............................   EUR zys(-)
cvx()                            1 Schaum         Zum Preis von............................   EUR zys(-)
Part B Topf
cvx()                            1 Schaum         Zum Preis von............................   EUR zys(-)
cvx()                            1 Schaum         Zum Preis von............................   EUR zys(-)

geht das auch so:

Part A Seife
cvx()                            1 Schaum         ..................                                                                                                                                                                                                                                              ..........   EUR zys(-)
[/url] [url=#_Toc193955830]cvx()                            1 Schaum         ..................                                                                                                                                                                                                                                              ..........   EUR zys(-)
Part B Topf
cvx()                            1 Schaum         ..................                                                                                                                                                                                                                                              ..........   EUR zys(-)
cvx()                            1 Schaum         ..................                                                                                                                                                                                                                                              ..........   EUR zys(-)

Danke das du mir hilfst.

Gruss

Dietmar

[Dietmar Henning]

Hallo Gerhard,

ich habe selber ein wenig rumprobiert und bin auf diese Lösung gekommen.
Würdest du sagen das ist programmtechnisch OK oder eher nicht so gut.

Makro: 
Sub InhaltsverzeichnisTest()
    Dim toc As TableOfContents
    Dim ihvBereich As Range
    Dim anzAbsaetze As Long

    ' Lösche vorhandenes Inhaltsverzeichnis, falls vorhanden
    'On Error Resume Next
    'ActiveDocument.TablesOfContents(1).Delete
    'On Error GoTo 0
   
    ' Füge ein neues Inhaltsverzeichnis hinzu
    Set toc = ActiveDocument.TablesOfContents.Add( _
        Range:=ActiveDocument.Range(0, 0), _
        UseHeadingStyles:=False, _
        IncludePageNumbers:=False, _
        RightAlignPageNumbers:=False, _
        UseHyperlinks:=True, _
        HidePageNumbersInWeb:=True, _
        UseOutlineLevels:=False)
   
    ' Füge die gewünschten Formatvorlagen hinzu
    toc.HeadingStyles.Add style:="Part_Überschrift", level:=1
    toc.HeadingStyles.Add style:="Positionsüberschrift", level:=2
    toc.HeadingStyles.Add style:="Preis", level:=3

    ' Absätze des IHV zählen
    Set ihvBereich = ActiveDocument.TablesOfContents(1).Range
    anzAbsaetze = ihvBereich.Paragraphs.count

    ' Schleife über alle Absätze des Inhaltsverzeichnisses
    For i = anzAbsaetze To 1 Step -1
        With ihvBereich
            ' Wenn ein Absatz mit 'Verzeichnis 2' formatiert ist...
            If .Paragraphs(i).style = "Verzeichnis 2" Then
                ' ...ersetze die Absatzmarke durch drei Leerzeichen (oder sonstwas)
                .Paragraphs(i).Range.Characters.Last = "  "
            End If
            ' Ersetze die Worte "Zum Preis von" durch Leerzeichen
            Dim absatzRange As Range
            Set absatzRange = .Paragraphs(i).Range
            absatzRange.Find.Execute FindText:="Zum Preis von", ReplaceWith:="", Replace:=wdReplaceAll
        End With
    Next i
End Sub

Es funktioniert auf jedenfall erstmal.

Danke für deine Hilfe.

Gruss

Dietmar

[Gerhard H]

Hallo Dietmar,

na, wenns funktioniert, wirds schon passen. Du kannst allenfalls 2 Zeilen Code einsparen, denn das Objekt, das du mit Set Absatzrange... definierst, hast du ja schon mit ihvbereich.Paragraphs(i).Range vor deiner Nase. Es müsste also reichen:

.Paragraphs(i).Range.Find.Execute FindText:="Zum Preis von", ReplaceWith:="", Replace:=wdReplaceAll

Getestet hab ichs nicht; falls das wider Erwarten nicht klappt, bleib halt bei deiner Lösung. 

Ich will dich aber noch auf zwei Einschränkungen der Makrolösung hinweisen:

1. Das funktioniert nur, wenn dein Original genau so strukturiert ist, wie dein Muster: Auf jede Ebene zwei folgt genau 1 Ebene 3. Folgen zwei Ebenen 3 hintereinander, wird nur die erste nach rechts versetzt; folgen zwei Ebenen 2 hintereinander, wird die Ebene 2 versetzt.
   
2. Beim Verschmelzen der Ebene2 mit der Ebene drei geht die Formatierung der Ebene 2 verloren, die du vielleicht in der Formatvorlage Verzeichnis 2 vorgenommen haben könntest. Manuell zugewiesene Formatierungen bleiben aber erhalten (so wie in deinem Muster).
   

Gegen beide Einschränkungen könnte man vielleicht was unternehmen. Ich hab mir aber noch nichts dazu überlegt, denn vielleicht ist es für dich nicht relevant.

[Dietmar Henning]

Hallo Gerhard,

danke das du dir Zeit für mich nimmst.
Das sind sehr gut Hinweise die ich umsetzen werde.
Leider bin ich auf ein großes Problem gestoßen, was ich nicht bedacht habe.

Ich bin davon ausgegangen, dass Ich in den Text immer die Formatvorlage "Positionsüberschrift" und "Preis" habe.
Also immer cvx() 1       Schaum (Level 2)und dann folgt danach Zum Preis von EUR   zys(-) (Level3).

Mir ist jetzt aber aufgefallen, dass ich bei manchen Textpositionen die Formatvorlage "Preis" nicht habe (was Level 3 wäre), also  Zum Preis von EUR   zys(-) .

Somit sieht das IHV dann so aus, wenn ich die Makro aktivieren:

Part A Deckel
cvx()    1 Schaumcvx()................................................................ 1 Schaum.   EUR zys(-)
Part B Topf
cvx()    1 Schaum......................................................................   EUR zys(-)
cvx()    1 Schaum......................................................................   EUR zys(-)

Es soll aber so aussehen:

Part A Deckel
cvx()    1 Schaum.....
cvx()    1 Schaum......................................................................   EUR zys(-)
Part B Topf
cvx()    1 Schaum......................................................................   EUR zys(-)
cvx()    1 Schaum......................................................................   EUR zys(-)

Ich habe schon versucht die Schleife zu verändern, doch leider ist es mir nicht gelungen diese so zu manipulieren. Mein Ansatz: ein Verzeichnis 2 nicht auf das Verzeichnis 2 verschoben werden darf bei der Absatzschleife.
Ich habe es leider nicht hinbekommen.
Im Anhang findest du noch meine geänderte Word-Datei.
Kannst du vielleicht diesbezüglich nochmal helfen?

Wenn ja, ich danke dir.

Gruss

Dietmar.

[Gerhard H]

Hallo Dietmar,

also treffen meine beiden nachgereichten Einschränkungen zu.

Dann kann wohl nicht einfach die Absatzmarke des Absatzes mit Verzeichnis 2 löschen, denn damit verliert er seine Formatvorlage (Verzeichnis 2) zugunsten des verschmolzenen Absatzes (Verzeichnis 3) und die Prüfung, ob zwei Absätze der Formatvorlage Verzeichnis 2 aufeinandertreffen ist nicht mehr möglich.

Vermutlich kann man die Absatzmarke im Verzeichnis 2 durch einen  Formatvorlagentrenner ersetzen, (Selection.InsertStyleSeparator), der es erlauben würde, zwei Absätze mit verschiedenen Formatvorlagen nebeneinander darzustellen. Ob das innerhalb eines Inhaltsverzeichnisses geht, muss ich erst rausfinden. Vielleicht krieg ich morgen oder am Wochenende was zustande. Ich melde mich wieder.

[Gerhard H]

Hallo Dietmar,

versuch mal diese Version:

Code:

'Absätze des IHV zählen
Set ihvBereich = ActiveDocument.TablesOfContents(1).Range
    anzAbsaetze = ihvBereich.Paragraphs.Count

    ' Schleife über alle Absätze des Inhaltsverzeichnisses
    With ihvBereich
        For i = anzAbsaetze To 1 Step -1

            ' Wenn ein Absatz mit 'Verzeichnis 2' formatiert ist...
            If .Paragraphs(i).Style = "Verzeichnis 2" Then
               
                '... und wenn der Folgeabsatz Verzeichnis 3 ist...
                If .Paragraphs(i + 1).Style = "Verzeichnis 3" Then
               
                '...dann ersetzen durch Formatvorlagentrenner:
                Selection.InsertStyleSeparator
                ' Ersetze die Worte "Zum Preis von" durch Leerzeichen
             ihvBereich.Paragraphs(i + 1).Range.Find.Execute FindText:="Zum Preis von", ReplaceWith:="", Replace:=wdReplaceAll
            End If
        End If
    Next i
    End With

Allerdings müsstest du dich hinsichtlich des Ersetzens entscheiden, ob du nach der deutschen  ("Zum Preis von..")  oder der englischen Version ("At a price of") suchen willst.