das ist wirklich beeindrucken. Danke für deine Hilfe.
Nur noch eine Frage. Ich wollte dass IHV gerne da positionieren, wo sich mein Cursor befindet. Um das zu erreichen, habe ich die Zeile Range:=ActiveDocument.Range(0, 0), _ auf Range:=Selection.Range, _ geändert.
Das Inhaltsverzeichnis wird jetzt auch an der Zeile erzeugt, wo ich es haben will, aber leider funktioniert die Verzeichnis Zuweisung nicht mehr. Bei den Inhaltsverzeichnis ohne Preise funktioniert es sehr gut. Weißt du woran das liegen kann. Im Anhang findest du meine aktuelle Word-Datei.
ich hab bisher meinen Makroteil immer isoliert am bereits bestehenden Inhaltsverzeichnis getestet. Deshalb musste ich erst mal eine Variable für den Inhaltsverzeichnisbereich erstellen (ihvBereich). Da der Teil aber in dein bisheriges Makro einfgefügt wird, hast du schon eine entsprechende Variable: mit set toc = Activedocument. TablesOfContents.Add... hast du eine Variable fürs IHV erstellt, und mit toc.Range kannst du dann weitermachen. Ersetze also den kompletten Teil ab 'Absätze des IHV zählen durch diesen:
Code:
'Absätze des IHV zählen anzAbsaetze = toc.Range.Paragraphs.Count 'ihvBereich.Paragraphs.count
' Schleife über alle Absätze des Inhaltsverzeichnisses With toc.Range 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: .Paragraphs(i).Range.Characters.Last.Select Selection.InsertStyleSeparator
' Ersetze die Worte "Zum Preis von" durch Leerzeichen .Paragraphs(i + 1).Range.Find.Execute FindText:="Zum Preis von", ReplaceWith:="", Replace:=wdReplaceAll End If End If Next i End With
Im übrigen hab ich auf die Schnelle nicht rausgefunden, warum es mit der alten Version nicht geklappt hat. Ich hab das aber nicht weiterverfolgt, weil es die neue Version ja tun sollte.
wenn ich deinem Dokument mit Alt-F9 in die Feldcode-Ansicht schalte, sehe ich, dass da bereits zwei Inhaltsverzeichnisse existieren (womöglich Reste von Experimentierversuchen). Darin könnte die Ursache zu finden sein, dass das alte Makro nicht funktioniert hat, weil es sich aufs erste vorhandene IHV bezieht, was u.U nicht identisch mit dem neu eingefügten ist. Ich empfehle dir, den auskommentierten Punkt mit dem Löschen eines eventuell schon vorhandenen Inhaltsverzeichnisses wieder zu aktivieren.
das funktioniert wirklich super. Danke das du mir Hilfst.
Ich habe mich jetzt an die Formatierung gesetzt im Verzeichnis 2 und habe die Tabstops gesetzt. Leider erstellt er nicht die Tabstops, die in der Formatvorlage Verzeichnis 2 vorgeben habe. In der Vorlage-Datei kannst du sehen, wenn ich manuell die Tabstops setzte, dann werden diese auch im richtigen Abstand im IHV erzeugt.
Ich habe es schon mit diesem Makroabschnitt probiert doch leider ohne Erfolg:
' Tabstops für 'Verzeichnis 2' übernehmen For i = 1 To anzAbsaetze If toc.Range.Paragraphs(i).style = "Verzeichnis 2" Then Dim tabStop As tabStop Dim newParagraph As Paragraph Set newParagraph = toc.Range.Paragraphs(i) newParagraph.TabStops.ClearAll For Each tabStop In ActiveDocument.Styles("Verzeichnis 2").ParagraphFormat.TabStops newParagraph.TabStops.Add Position:=tabStop.Position, Alignment:=tabStop.Alignment, Leader:=tabStop.Leader Next tabStop
Kennst du einen Befehl, wo er selber im IHV die Tabstops setzt wie in der Vorlage-Datei gezeigt?
Kann man auch die Zeilen die mit der Formatvorlage Option formatiert wurden so im IHV erzeugen, dass die Preise eingerückt sind wie in der Vorlage-Datei manuell gezeigt?
wenn die Tabulatoren in den Verzeichnisvorlagen korrekt gesetzt sind, gibt es keinen Grund, etwas nachbearbeiten zu müssen. Allerdings gibt es durch das Nebeneinandersetzen von zwei Absätzen zu beachten, dass die aktuell eingestellten Tabstoppweiten unmöglich passen können: Beispiele: Die ersten Tabstopps in Verzeichnis 3 haben Weiten von 2,12 cm bis 3,58. Die können gar nicht greifen, wenn Verzeichnis 2 einen Tabstopp bei 12 cm drin hat. Und du hast sowohl in V2 als auch in V3 einen Dezimalstopp drin. Der gehört meiner Meinung nur zum Verzeichnis 3. Außerdem ist er mit 16 cm genau am eingestellten rechten Seitenrand positioniert, so dass die Dezimalzahlen darüber hinausgehen müssten. Stell den mal probehalber auf 15 cm. Dann sollte doch eigentlich alles passen.
Das mit der Formatvorlage Option würde voraussetzen, dass sie einer anderen Ebene als Ebene 3 zugeordnet wird. Nur dann kann man abweichende Tabulatoren setzen. Das Makro könnte man vermutlich anpassen, aber ich würde das gern vertagen, bis das erste Problem gelöst ist.
kann es sein, dass die Tabs von den Formartierten Zeilen (Text) Positionsüberschrift und Preis nicht bei der Erstellung des IHV übernommen werden? Ich habe dank deiner Hinweise die Tabstops angepasst im Verzeichnis 2 und 3 doch das IHV ändert sich erst, wenn ich manuelle die Tabs manuell an der Position einfüge wo Sie sein sollen laut Formatmatierter Zeile (Text) mit Positionsübersicht und Preis. Ich habe dir die Tabs mal in der Word-Datei rot markiert die ich meine an einer Zeile.
Das ist mir bisher noch nicht aufgefallen, aber das ist offenbar so, und nicht nur in unserem kunstvollen Inhaltsverzeichnis, sondern auch in einem ganz normalen. Die Regel scheint zu sein: Das erste Tabulatorzeichen in der Überschrift im Text wird übernommen, alle weiteren werden durch ein Leerzeichen ersetzt. Das wäre ja im Fall von EUR xxx.xxx zu verschmerzen, und im Fall von 1 Verrohrung vielleicht auch, wenn es sich da um eine Mengenangabe handelt.
Darüberhinaus ist mir völlig unklar, wie die Tabulatorweiten des ersten Tabulators im Text ins Inhaltsverzeichnis übernommen werden. Da muss man offenbar nehmen, was man kriegt.
Ein einigermaßen passables Verzeichnis krieg ich mit etwas Trickserei so hin:
a) Aus der Vorlage Verzeichnis 2 und 3 lösche ich sämtliche Tabulatoreneinträge raus. b) Beim ersetzen der Zeichenfolge zum Preis von... entferne ich das Tabulatorzeichen danach gleich mit:
Das Inhaltsverzeichnis verhält sich dann so, als würde nach dem Formatvorlagentrenner die Seitenzahl folgen (d.h. es wird automatisch ein rechtsbündiger Tabulator eingefügt (der zwar im Lineal, nicht aber im Vorlagenverzeichnis auftaucht). Wenn nach dem Dezimalzeichen immer zwei Stellen folgen, ist ein Dezimaltabulator ja gar nicht nötig.
Ich häng das Ergebnis mal an (entstanden durch Anwendung der Prozedur "mit Preis". Wenn du das auch so hinkriegst und es dir so passabel erscheint, halte ich das Ende der Fahnenstange für erreicht. Ich kann mich höchstens noch am Einzug der Formatvorlage Option versuchen. Mit Tabulatoren wirds nicht gehen, aber wahrscheinlich mit einem rechten Absatzeinzug.
Und immer schön dran denken: Das Kunstwerk darf nie nicht aktualisiert werden!
du hast recht das IHV ist wirklich schon ein Kunstwerk, aber nur durch deine Unterstützung.
Ich glaube ich habe für meine Anwendung ein Lösung gefunden mit den Tabulatoren. Ich habe vor den jeweilgen Positionen ein ß gemacht und ahbe dann in der Makro folgende Zeile hinzugefügt: ' Ersetze die Worte "ß" durch Tabulator .Paragraphs(i + 1).Range.Find.Execute FindText:="ß", ReplaceWith:=vbTab, Replace:=wdReplaceAll
Somit setzt er jetzt den Buchstaben ß durch ein Tabulator.
In der Word-Datei habe ich dann den Buchstaben ß weiß gemacht, damit man diesen nicht sieht. Ich denke das sollte so passen.
Jetzt muss es nur noch funktionieren, dass alle Preise für die Positionen die als OP ausgewiesen sind eingerückt werden und kursiv dargestellt werden.
Ich ahbe Ihm gesagt, dass er das Wort EUR suchensoll und danach einen tab setzten soll und nach dem ersten Wort suchen was Fett ist und davor einen Tab setzen. Es hat funktioniert und alle Tabs werden erzeugt (siehe Anhang)
Jetzt fehlt nur noch das alle Zeilen die die Buchstabenkombination OP haben kursiv ausehen sollen und nach dem Worte EUR der Preis eingerückt werden soll.
' Absätze des IHV zählen anzAbsaetze = toc.Range.Paragraphs.count
' Zusätzliche Schleife über alle Absätze des Inhaltsverzeichnisses von oben nach unten With toc.Range For i = 1 To anzAbsaetze ' Wenn ein Absatz mit 'Verzeichnis 3' formatiert ist... If .Paragraphs(i).style = "Verzeichnis 3" Then ' Ersetze die Worte "Zum Preis von" durch Leerzeichen im IHV Call ReplaceTextInTOC(.Paragraphs(i).Range, "Zum Preis von", "") ' Ersetze die Worte "At a price of" durch Leerzeichen im IHV Call ReplaceTextInTOC(.Paragraphs(i).Range, "At a price of", "") End If Next i End With
' Schleife über alle Absätze des Inhaltsverzeichnisses von unten nach oben With toc.Range 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 i < anzAbsaetze And .Paragraphs(i + 1).style = "Verzeichnis 3" Then
' Entferne die Formatvorlagentrenner und füge die Texte in einer Zeile zusammen: .Paragraphs(i).Range.Characters.Last.Select Selection.Delete Unit:=wdCharacter, count:=1
' Füge nach dem Wort "EUR" im Absatz mit Verzeichnis 3 einen Tabulator ein Call InsertTabAfterEUR(.Paragraphs(i + 1)) End If ' Füge einen Tabulator vor dem ersten fett formatierten Wort im Absatz mit Verzeichnis 2 ein Call InsertTabBeforeFirstBoldWord(.Paragraphs(i)) End If Next i End With
' Überprüfe und formatiere Zeilen, die mit "OP" beginnen Call FormatLinesStartingWithOP(toc.Range)
' Setze Tabulatoren in kursiv formatierten Zeilen Call SetTabsInItalicLines(toc.Range) End Sub
Sub ReplaceTextInTOC(rng As Range, findText As String, replaceText As String) ' Ersetze Text nur im Inhaltsverzeichnis Dim tocRange As Range Set tocRange = rng.Duplicate With tocRange.Find .ClearFormatting .Text = findText .Replacement.ClearFormatting .Replacement.Text = replaceText .Wrap = wdFindStop .Execute Replace:=wdReplaceAll End With End Sub
Sub InsertTabAfterEUR(paragraph As paragraph) ' Füge nach dem Wort "EUR" einen Tabulator ein Dim rng As Range Set rng = paragraph.Range ' Suche nach "EUR" und füge Tabulator hinzu With rng.Find .ClearFormatting .Text = "EUR " .Replacement.ClearFormatting .Replacement.Text = "EUR" & vbTab .Wrap = wdFindContinue .Execute Replace:=wdReplaceAll End With End Sub
Sub InsertTabBeforeFirstBoldWord(paragraph As paragraph) Dim rng As Range Dim charIndex As Long Dim foundBold As Boolean
Set rng = paragraph.Range foundBold = False ' Flag, um zu überprüfen, ob ein fett formatiertes Wort gefunden wurde ' Durchlaufe jeden Charakter im Absatz For charIndex = 1 To rng.Characters.count ' Überprüfe, ob das Zeichen fett formatiert ist If rng.Characters(charIndex).Font.Bold Then ' Füge einen Tabulator vor dem ersten fett formatierten Wort ein rng.Characters(charIndex).InsertBefore vbTab foundBold = True ' Setze das Flag auf wahr, da ein fett formatiertes Wort gefunden wurde Exit For ' Beende die Schleife, nachdem das erste fett formatierte Wort bearbeitet wurde End If Next charIndex End Sub
Sub FormatLinesStartingWithOP(rng As Range) Dim para As paragraph For Each para In rng.Paragraphs If Left(para.Range.Text, 2) = "OP" Then para.Range.Font.Italic = True End If Next para End Sub
Sub SetTabsInItalicLines(rng As Range) Dim para As paragraph For Each para In rng.Paragraphs If para.Range.Font.Italic Then ' Setze den 3. Tabulator auf 9 cm para.TabStops.Add Position:=CentimetersToPoints(9), Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces ' Setze den 4. Tabulator auf 12,5 cm para.TabStops.Add Position:=CentimetersToPoints(12.5), Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces End If Next para End Sub
Danke nochmal für deine Zeit und ich wünsche dir und deiner Familie schon mal ein schönes Wochenende.
automatisches Inhaltsverzeichnis erstellen
