MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Word
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 14.03.2019, 10:59   #1
KQLAndy
MOF User
MOF User
Standard Word 2013 - Bildnummern mit Verweisen ab bestimmter Zahl starten lassen (VBA)

Hallo zusammen,
ich füge für meine Abbildungen mit folgendem Code meine Captions ein:
Code:

Thisdocument.ContentControls(1).Range.InsertCaption label:="Fig ", title:="MeinBild", position:=wdCaptionPositionBelow, ExcludeLabel:=0
Gibt es eine Möglichkeit die automatische Nummerierung ab einer bestimmten Zahl zu starten? Z.B. dass die erste Abbildung in einem Dokument "Fig 13" heißt, statt "Fig 1"?



Der Grund ist folgender:
Ich habe zwei WORD-Dokumente in denen beispielhaft je zwei Bilder vorhanden sind. In Freitexten, die in den jeweiligen Dokumenten sind, wurden die Bilder per Querverweis verknüpft. Somit habe ich in jedem Dokument einen Querverweis auf "Fig. 1" und auf "Fig. 2".
Wenn ich nun das gesamte zweite Dokument kopiere und unter das erste Dokument einfüge, habe ich vier Bilder und vier Querverweise (Zwei mal "Fig 1" und zwei mal "Fig 2").

Wenn ich nun mit
Code:

ThisDocument.Fields.Update
die Felder aktualisiere, habe ich für die Bilder die richtige Reihenfolge von "Fig 1" bis "Fig 4". Leider verlieren die Querverweise aber ihren konkreten Zusammenhang zum eigentlichen Bild und aktualisieren sich nicht bis "Fig 4", sonder bleiben auf "Fig 1" bzw "Fig 2". Somit verweisen die Querverweise der Bilder "Fig 3" und "Fig 4" nach der aktualisierung auf die Bilder "Fig 1" und "Fig 2".

Ich hoffe ich konnte es verständlich erklären. Daher akm mir die Idee vor dem Kopiervorgang die Bilder aus dem zweiten Dokument direkt ab "Fig 3" beginnen zu lassen. Somit würden die Verweise den Zusammenhang nicht verlieren.

Hat einer von euch eine Idee oder andere Herangehensweise?

__________________

Gruß
KQLAndy
KQLAndy ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 15:43   #2
Gerhard H
MOF Guru
MOF Guru
Standard

Hallo Andy,

ich hab zwar deine Frage verstanden, nicht aber deine Hintergrundbeschreibung. Deswegen weiß ich nicht, ob dir folgende Lösung wirklich was nützt:

Da InsertCaption eine komplette Beschriftung mit Label und SEQ-Feld erzeugt, könntest du nur im Nachhinein tätig werden und das SEQ-Feld um den Schalter /r ergänzen, dem du eine Startnummer mitgeben kannst:
Code:

Sub startnummer()
Dim beschriftung As Range

ThisDocument.ContentControls(1).Range.InsertCaption _
Label:="Fig", Title:=" Meinbild", Position:=wdCaptionPositionBelow
Set beschriftung = ThisDocument.ContentControls(1).Range
beschriftung.Fields(1).Select
ActiveDocument.Fields.Add Range:=Selection.Range, Text:="SEQ Fig r13 *Arabic"
End Sub

__________________

Gruß
Gerhard
Gerhard H ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 16:32   #3
KQLAndy
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Gerhard,
ich werde deinen Ansatz unter die Lupe nehmen. Vielen Dank dafür.
Verstehe noch nicht so ganz was da passiert, aber das werde ich mir mal schön erarbeiten, dann lernt man es auch richtig

__________________

Gruß
KQLAndy
KQLAndy ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 16:53   #4
Gerhard H
MOF Guru
MOF Guru
Standard

Hallo Andi,

Da gibt's nicht viel zu verstehen, ich ersetze einfach das SEQ-Feld durch das gleiche mit einem Schalter /r, mit dem du einen Startwert festlegen kannst.

__________________

Gruß
Gerhard
Gerhard H ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 14.03.2019, 21:23   #5
Fennek11
MOF Profi
MOF Profi
Standard

Hallo,

ich hatte die Frage so verstanden, dass für die Bilder eine beliebige Startnummer und Beschreibung vergeben werden kann.

Die Idee: das SEQ-Feld zu löschen:

Code:

Sub T_1()
Tx = Array("See", "Gebirge")
With ActiveDocument.InlineShapes
For i = 1 To .Count
    If .Item(i).Type = wdInlineShapePicture Then
        .Item(i).Range.InsertCaption CaptionLabels(4), i + 12 & ": " & Tx(i - 1), "", wdCaptionPositionBelow, 0
        ActiveDocument.Fields(1).Delete 'löschen der Voreinstellung Fields("SEQ")
    End If
Next i
End With
End Sub
mfg
Fennek11 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 20.05.2019, 11:32   #6
KQLAndy
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo zusammen,
ich danke für eure schnellen Antworten, ich bin aber leider erst jetzt dazu gekommen den Punkt auf meiner To-Do-Liste in Angriff zu nehmen.

@Gerhard
Dein Codebeispiel funktioniert bei mir leider nicht. Ich habe ihn ein wenig auf meinen Code adaptiert, wobei eigentlich keine Fehler passiert sein können.
Der Laufzeitfehler 4605 mit dem Text "Dieser Befehl ist nicht verfügbar" wird mir angezeigt.
Der Code würde aber wahrscheinlich genau das machen was ich brauche.
Also das Bild "Screenshot 1" zeigt an der gelben Markierung die Zeile, welche den Fehler auslöst.
Bild "Screenshot 2" zeigt, dass das richtige Field selektiert ist. Irgendetwas mache ich wohl falsch. Hast du noch eine Idee?
Angehängte Grafiken
Dateityp: png Screenshot 1.png (13,1 KB, 6x aufgerufen)
Dateityp: png Screenshot 2.png (1,5 KB, 2x aufgerufen)

__________________

Gruß
KQLAndy
KQLAndy ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 20.05.2019, 13:39   #7
Gerhard H
MOF Guru
MOF Guru
Standard

Hallo Andy,

in deinem Bild vom Code fehlt mir die wichtigste Zeile:
Code:

ThisDocument.SelectContentControlsByTag("figcaption2").Item(1).Range.InsertCaption _
Label:="Fig", Title:=" Meinbild"
Mit dieser funktioniert bei mir der Code, auch in dieser Variante:
Code:

Sub beschriftung()
Dim beschriftung As Range
With ActiveDocument
 .SelectContentControlsByTag("figcaption2").Item(1).Range.InsertCaption Label:="Fig ", Title:="MeinBild", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
 Set beschriftung = .SelectContentControlsByTag("figcaption2").Item(1).Range
    beschriftung.Fields(1).Code.Text = "SEQ Fig \r 13"
End With

ThisDocument.Fields.Update
End Sub
Eine Fehlermeldung gibt es in beiden Varianten unter der Bedingung, dass das ContentControl nicht leer war: "4198 - Befehl misslungen". Er bezieht sich auf das Einfügen der Beschriftung in der ersten Zeile.

Dann würde das vorherige Leeren des ContentControl genügen, es sei denn, du hast da was drin, was drin bleiben muss (vielleicht sogar das Bild?). Da dies nicht weiß, und auch nicht, was genau deine Fehlermeldung verursacht, wirds ohne Musterdokument ein Rätselraten.

Und noch eine Bitte für die Zukunft: Quelltext bitte nicht als Bild, damit man ihn zum Testen nicht abtippen muss.

__________________

Gruß
Gerhard

Geändert von Gerhard H (20.05.2019 um 13:45 Uhr). Grund: Code angepasst
Gerhard H ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 20.05.2019, 14:47   #8
KQLAndy
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Gerhard,
Deine letzte Variante funktioniert bei mir auch!!! Die Zuordnung nach .Code.Text war die klärende Lösung.
Mit dem Code im Bild hast du natürlich recht, dass werde ich in Zukunft beachten!

Also vielen Dank für deine Hilfe und Lösung meines Problems, habe mich wiedermal sehr gut aufgehoben gefühlt!

__________________

Gruß
KQLAndy
KQLAndy ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 04:35 Uhr.



Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.