37414
Goto Top

Word Makro - Objekt mit Text verschieben

Hallo,

in einem anderen Thread hatte ich schon Hilfe bei einem Word-Makro (Word 2000) erhalten.

Das Skript ist dieses hier:

Sub Unterschrift()
'  
' Unterschrift per Makro einsetzen  
'  
    Dim img As InlineShape, shp As Shape
    Set img = Selection.InlineShapes.AddPicture("C:\Users\name\Desktop\IM.jpg")  
    Set shp = img.ConvertToShape
    shp.WrapFormat.Type = wdWrapNone
End Sub

Nun würde ich gerne das Bild (Unterschrift) so einsetzen, dass sie automatisch mit nach unten gerückt wird, wenn man weiter oben noch Text schreibt... also wenn man weitere Zeilen weiter oben einfügt.
Manuell geht das, wenn ich über "Grafik formatieren / Layout / Weitere / "Objekt mit Text verschieben"" anhake.

Wie aber mache ich das über mein Script?
Was muss ich dazu an dem Script ändern?

Danke und Gruss,
imebro

Content-Key: 259817

Url: https://administrator.de/contentid/259817

Printed on: April 25, 2024 at 07:04 o'clock

Member: colinardo
Solution colinardo Jan 14, 2015, updated at Jan 22, 2015 at 09:09:22 (UTC)
Goto Top
Hallo imebro,
sollte mit folgender Ergänzung funktionieren. Unter Word 2010 ist das Verhalten zwar Standardmäßig so das das Bild mit dem Text verschoben wird, aber ich denke das es an Word 2000 liegt das dem nicht so ist.
Sub Unterschrift()
'  
' Unterschrift per Makro einsetzen  
'  
    Dim img As InlineShape, shp As Shape
    Set img = Selection.InlineShapes.AddPicture("C:\Users\name\Desktop\IM.jpg")  
    Set shp = img.ConvertToShape
    With shp
        .WrapFormat.Type = wdWrapNone
        .RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
    End With
End Sub
Grüße Uwe
Mitglied: 37414
37414 Jan 15, 2015 updated at 10:30:52 (UTC)
Goto Top
Super... vielen Dank.

Hat funktioniert.

Zwei Fragen hätte ich jedoch noch:

1) Im Moment wird das Foto ja mit "Vor den Text" formatiert. Was muss ich für "Hinter den Text" im Makro ändern?

2) Im Moment muss ich zur Einfügung dieses Fotos per Makro, mit dem Cursor an die Stelle navigieren, wo es hingehört - also unter den Satz "Mit freundlichen Grüßen". Ist es möglich, dieses Foto von jeder beliebigen Cursorposition aus dort hin per Makro einzufügen?
Ich könnte mir z.B. so eine Art "Anker" oder "Textmarke" vorstellen... Diese könnte im Makro dann der Satz "Mit freundlichen Grüßen" sein und das Foto müßte dann halt eine Zeile darunter eingefügt werden.
Dieses Makro könnte am besten dann auch gleich automatisch noch eine Zeile unter dem Bild einfügen mit "Position und Abteilung" face-smile

Wäre perfekt, wenn das geht, denn dann könnte ich dieses Makro quasi in meinem Drucken-Makro aufrufen lassen oder dort integrieren.
Dabei könnte man dann von jeder beliebigen Position des Schreibens aus das Makro "Druck + Unterschrift" auslösen und dann würde zunächst die Unterschrift unter dem Satz "Mit freundlichen Grüßen" eingefügt und danach würde gedruckt face-wink


Ich habe gerade etwas herum getestet...
Wenn die Unterschrift als Foto (.jpg) auf dem Desktop jedes Mitarbeiters gleich heißt "Unterschrift.jpg", dann kann ich in Word 2000 dieses Foto über "Objekt verknüpfen" an die gewünschte Stelle einfügen.
Damit das funktioniert, muss ich zunächst im Dokument in den Optionen des Druckmenüs "Verknüpfungen aktualisieren" anhaken. Nun noch die Grafik formatieren (hinter den Text) und dann das Dokument speichern.
Egal welcher Mitarbeiter dieses Dokument nun aufruft... es wird seine individuelle Unterschrift an der gewünschten Stelle eingefügt.

Die Frage ist nun, welche der beiden Varianten der geeignetere Weg wäre?
a) Unterschrift schon im Dokument speichern als "Unterschrift.jpg" und dann mein Druck-Makro per Klick ausführen?
b) Das Einfügen des Fotos "Unterschrift.jpg" mit ins Druck-Makro übernehmen, wie eingangs vorgesehen?

...Bin gespannt...

Danke und Gruss,
imebro
Member: colinardo
colinardo Jan 15, 2015 at 10:22:39 (UTC)
Goto Top
1) Im Moment wird das Foto ja mit "Vor den Text" formatiert. Was muss ich für "Hinter den Text" ändern?
Das geht mir der Konstanten wdWrapBehind

zu 2
Das geht, aber warum willst du das Bild im Hintergrund haben ? Denn wenn man es in den Hintergrund setzt ist es wieder aus dem Kontext gezogen und man müsste mehrere Zeilen hinter Mit freundlichen Grüßen einfügen da beim Einfügen nur einer Zeile diese dann über die Unterschrift gezogen würde. Deswegen nutzt man hier normalerweise ein Inline-Shape, dann wird die nächste Zeile unter der Unterschrift platziert.
Mitglied: 37414
37414 Jan 15, 2015 updated at 10:30:11 (UTC)
Goto Top
...ok...

Wenn ich das Foto mit "Hinter den Text" einsetze, funktioniert das aber eigentlich recht gut.
Im Dokument sind eh 5 Zeilen Platz, wo das Foto dann eingesetzt wird. Von daher gibt es eigentlich keine Probleme.
Der große Vorteil bei "Hinter den Text" statt "Vor den Text" ist, dass dann in jedem Fall kein Text vom Foto überlagert wird.
"Notfalls" würde sich höchstens ein kleines Stückchen der Unterschrift über den Text darüber / darunter legen... und das passiert ja auch, wenn man per Hand unterschreibt face-wink Das war meine Überlegung face-wink

Hast Du auch die "neue Idee" in meinem letzten Posting schon gelesen (unter den Trennstrichen)?
Das wäre auch eine Möglichkeit...

Danke und Gruss,
imebro
Member: colinardo
colinardo Jan 15, 2015 updated at 10:30:50 (UTC)
Goto Top
Hast Du auch die "neue Idee" in meinem letzten Posting schon gelesen?
Das wäre auch eine Möglichkeit...
Möglich ist alles, das musst du selber entscheiden. Ich kenne deinen Workflow nicht.
Member: colinardo
colinardo Jan 15, 2015 updated at 10:44:19 (UTC)
Goto Top
Ich würde das wenn's per Code sein soll so machen:
Sub Unterschrift()
'  
' Unterschrift per Makro einsetzen  
'  
    Dim img As InlineShape, posImage As Range, posAbteilung As Range
    Selection.GoTo wdGoToPage, wdGoToFirst
    With ActiveDocument.Content.Find
        .Text = "Mit freundlichen Grüßen"  
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
        .Execute
        If .Found Then
            .Parent.InsertParagraphAfter
            .Parent.InsertParagraphAfter
            Set posImage = .Parent.GoTo(wdGoToLine, wdGoToNext)
            Set img = posImage.InlineShapes.AddPicture("D:\Unterschrift.png")  
            Set posAbteilung = posImage.GoTo(wdGoToLine, wdGoToNext)
            posAbteilung.Text = "[POSITION] [ABTEILUNG]"  
        End If
    End With
End Sub

Und beschäftige dich mal mit den Referenzen, dann musst du nicht wegen jeder Konstanten fragen face-wink
back-to-topVBA/VBS/WSH/Office Developer Referenzen

Viel Erfolg!
Mitglied: 37414
37414 Jan 15, 2015 at 10:36:24 (UTC)
Goto Top
Hier wäre mal ein Beispiel:


LG
imebro
Mitglied: 37414
37414 Jan 15, 2015 at 10:50:35 (UTC)
Goto Top
Danke für Deinen Code...

Habe es soeben getestet.
Die Unterschrift (also das JPG) schaut nur ca. 2mm unter "Mit freundlichen Grüßen" raus... der Rest steht im Hintergrund und ist nicht sichtbar.
Weiterhin ist es auch nicht mit "Hinter den Text" formatiert... oder war das Deine Absicht?

Danke und Gruss,
imebro
Member: colinardo
Solution colinardo Jan 15, 2015, updated at Jan 22, 2015 at 09:09:10 (UTC)
Goto Top
Zitat von @37414:
Die Unterschrift (also das JPG) schaut nur ca. 2mm unter "Mit freundlichen Grüßen" raus... der Rest steht im
Hintergrund und ist nicht sichtbar.
Habe hier leider kein so altes Word 2000 da, unter Word 2010 geht es einwandfrei ...
Weiterhin ist es auch nicht mit "Hinter den Text" formatiert... oder war das Deine Absicht?
Das war Absicht!

machs mal hiermit, vermutlich ist dann Word 2000 eher zufrieden ...:
Sub Unterschrift()
'  
' Unterschrift per Makro einsetzen  
'  
    Dim img As InlineShape, shp As Shape, posImage As Range, posAbteilung As Range
    Selection.GoTo wdGoToPage, wdGoToFirst
    With ActiveDocument.Content.Find
        .Text = "Mit freundlichen Grüßen"  
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
        .Execute
        If .Found Then
            .Parent.InsertParagraphAfter
            .Parent.InsertParagraphAfter
            Set posImage = .Parent.GoTo(wdGoToLine, wdGoToNext,1)
            Set img = posImage.InlineShapes.AddPicture("D:\Unterschrift.png")  
            Set shp = img.ConvertToShape
            With shp
                .WrapFormat.Type = wdWrapTopBottom
                .RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
            End With
            Set posAbteilung = posImage.GoTo(wdGoToLine, wdGoToNext,1)
            posAbteilung.Text = "[POSITION] [ABTEILUNG]"  
        End If
    End With
End Sub

Man kann alternativ natürlich an den entsprechenden Stellen Textmarken (Bookmarks) in der Vorlage setzen und diese dann mit den entsprechenden Daten ersetzen anstatt nach dem Text Mit freundlichen Grüßen zu suchen.

Wie immer gibt es hier 1000 und 1 Weg zum Ziel...
Mitglied: 37414
37414 Jan 15, 2015 updated at 11:07:42 (UTC)
Goto Top
OK und danke face-smile

Jetzt steht die Unterschrift (JPG) mehrere Zeilen ÜBER dem Text "Mit freundlichen Grüßen".
Vielleicht wäre ja die Variante doch besser, die ich weiter oben beschrieben hatte.

Ich meine die, wo die Unterschrift bereits als verknüpftes Objekt mit im Dokument gespeichert und formatiert ist.
Wie ja oben schon beschrieben, hat dann das Foto mit der individuellen Unterschrift jedes Mitarbeiters den gleichen Namen "Unterschrift.jpg". Das geht, da dieses auf dem jeweiligen Mitarbeiter-Desktop liegt.

Dann müßte ich nur noch das Druck-Makro aufrufen, ohne dass darüber dann auch die Unterschrift noch eingefügt werden muss.

Oder halt die Variante mit den Textmarken, die Du eben noch angeführt hattest?

Hmmm... wie würdest Du es machen? face-wink

Danke und Gruss,
imebro
Member: colinardo
colinardo Jan 15, 2015 updated at 11:14:22 (UTC)
Goto Top
Zitat von @37414:
Jetzt steht die Unterschrift (JPG) mehrere Zeilen ÜBER dem Text "Mit freundlichen Grüßen".
Wie gesagt kein Word 2000 zu Testen hier, das scheint sich doch sehr anders zu verhalten als die aktuellen Versionen.

Oder halt die Variante mit den Textmarken, die Du eben noch angeführt hattest?
Hmmm... wie würdest Du es machen? face-wink
Das ist immer auf den jeweiligen Workflow bezogen, das musst du für dich entscheiden. Wenn das mit der Verknüpfung bei dir läuft mach's damit.

Grüße Uwe
Mitglied: 37414
37414 Jan 15, 2015 updated at 12:30:24 (UTC)
Goto Top
Danke für Deine Links...

Ich habe jetzt "Bottom" durch "Behind" in Deinem Code ersetzt und jetzt paßt die Unterschrift perfekt und steht am richtigen Platz.

Das was unter der Unterschrift stehen soll, steht jedoch daneben.
Wenn ich nun manuell 3 x ENTER eingebe, dann paßt es.
Daher habe ich eben recherchiert und gefunden, dass man mit "& vbCrLf" eine Zeilenschaltung eingeben kann.
Leider funktioniert das nicht, wenn ich dies einfach im Code über "SetPos......." eingebe.
Wie genau muss ich das im Code eintragen?

Zusätzlich soll das, was in "Abteilung" steht, noch in Schriftgröße "Arial 9" sein face-smile

LG
imebro
Mitglied: 37414
37414 Jan 16, 2015 at 12:56:19 (UTC)
Goto Top
...hat vielleicht sonst noch Jemand eine Idee bezüglich der Zeilenschaltungen?

Danke und Gruss,
imebro
Member: colinardo
colinardo Jan 17, 2015 updated at 12:58:47 (UTC)
Goto Top
So jetzt hatte ich wieder Zeit für den alten Word-Schinken face-wink
Ich habe jetzt extra für dich mal mit einem Word 2000 in einer VM getestet und damit geht es hier einwandfrei:

Hier als Beweis:
fb4b35207aa7c93e0421b85d58458c64

Sub Unterschrift()
    Dim img As InlineShape, posImage As Range, posAbteilung As Range
    Selection.GoTo wdGoToPage, wdGoToFirst
    With ActiveDocument.Content.Find
        .Text = "Mit freundlichen Grüßen"  
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
        .Execute
        If .Found Then
            .Parent.InsertParagraphAfter
            .Parent.InsertParagraphAfter
            Set posImage = .Parent.GoTo(wdGoToLine, wdGoToNext, 1)
            Set img = posImage.InlineShapes.AddPicture("d:\signature.png")  
            Set posAbteilung = posImage.GoTo(wdGoToLine, wdGoToNext, 1)
            With posAbteilung
                .End = .Paragraphs(1).Range.End
                .Font.Name = Arial
                .Font.Size = 9
                .Text = "Dr. Ing. / Ingenieur"  
            End With
        End If
    End With
End Sub
Hier auch das Testdokument(Word 2000) dazu (Pfad zur Grafik natürlich anpassen):
insert_signature_word2000_259817.doc


Und hier noch ein zweites Demo-Dokument (Word 2000) das es anhand von eingefügten Textmarken (Einfügen > Textmarken) macht (Pfad zur Grafik natürlich anpassen):
insert_signature_word2000_textmarker_259817.doc

Sub Unterschrift()
    With ActiveDocument
        .Bookmarks("Unterschrift").Range.InlineShapes.AddPicture "D:\signature.png"  
        .Bookmarks("Subtext").Range.Text = "Dr. Ing. / Ingenieur"  
    End With
End Sub
So, damit solltest du versorgt sein.

Grüße Uwe
Mitglied: 37414
37414 Jan 17, 2015 at 15:18:14 (UTC)
Goto Top
Hey, vielen Dank für Deine Mühe... ist ja irre, was Du für einen Aufwand dafür gemacht hast *DAUMEN HOCH* face-wink

Werde das dann gleich am Montag testen, wenn ich wieder auf der Arbeit bin.

Schöne Grüße,
imebro
Mitglied: 37414
37414 Jan 19, 2015 updated at 14:47:15 (UTC)
Goto Top
Hallo und nochmals danke...
Mitglied: 37414
37414 Jan 19, 2015, updated at Jan 20, 2015 at 08:01:29 (UTC)
Goto Top
Habe jetzt nochmal etwas herum probiert...

Jetzt funktioniert es... fast face-wink

Hier der komplette Code, den ich jetzt entsprechend abgeändert habe
==>> Ich habe die Zeilen 15 bis 19 hinzugefügt und in den Zeilen 20 bis 33 jeweils Änderungen vorgenommen

Sub Unterschrift()
    Dim img As InlineShape, posImage As Range, posAbteilung As Range, posImAuftrag As Range
    Selection.GoTo wdGoToPage, wdGoToFirst
    With ActiveDocument.Content.Find
        .Text = "Mit freundlichen Grüßen"  
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
        .Execute
        If .Found Then
            .Parent.InsertParagraphAfter
            .Parent.InsertParagraphAfter
            Set posImage = .Parent.GoTo(wdGoToLine, wdGoToNext, 1)
            Set img = posImage.InlineShapes.AddPicture("C:\Users\name\Desktop\Unterschrift.jpg")  
            Set shp = img.ConvertToShape
            With shp
                .WrapFormat.Type = wdWrapTopBehind
                .RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
            End With
            Set posAbteilung = posImage.GoTo(wdGoToLine, wdGoToNext, 1)
            With posAbteilung
                .End = .Paragraphs(1).Range.End
                .Font.Name = Arial
                .Font.Size = 9
                .Text = vbCrLf & vbCrLf & vbCrLf & "Abteilung"  
            End With
            Set posImAuftrag = posAbteilung.GoTo(wdGoToLine, wdGoToNext, 1)
            With posImAuftrag
                .End = .Paragraphs(1).Range.End
                .Font.Name = Arial
                .Font.Size = 11
                .Text = vbCrLf & "i. A."  
            End With
        End If
    End With
End Sub

Das einzig seltsame ist, dass ich die Einstellungen für die Abteilung ÜBER denen für i. A. setzen mußte, da ansonsten immer der Text "Abteilung" ÜBER dem Text "i. A." stand.

Zur Info zu den Bildeinstellungen:
1) Vorher hatte ich mit Rechtsklick auf das Bild "Grafik formatieren / Layout / Weitere / Bildposition / "Objekt mit Text verschieben"" angehakt.
Offenbar wird diese Einstellung mit dem Dokument gespeichert.

2) Offenbar hat das "wdWrapTopBehind" (Zeile 17 im Code) keine Auswirkung. Denn wenn man manuell nachsieht, ist im Layout des Fotos immer noch "Rechteck" ausgewählt. Aber wenigstens wird nun alles komplett verschoben, wenn man oben im Dokument weitere Zeilen einfügt.

Hier nochmal zur Verdeutlichung, welche Änderungen ich manuell in den Bildeinstellungen vorgenommen habe:

8cd36061b5f6eb00c56b3b459569ccde

Man sieht hier, dass ich "Hinter den Text" ausgewählt habe, obwohl es jetzt auch ohne geht... also mit "Rechteck". Mit "Hinter den Text" hätte man jedoch den Vorteil, dass man bei Platzmangel die Unterschrift einfach etwas nach oben schieben könnte, welche sich dann halt etwas über den Text "Mit freundlichen Grüßen" schieben würde. Das kommt bei einer manuellen Unterschrift ja auch so vor.

Die Absolute Position habe ich auf "0,01 cm" gesetzt, wodurch das Bild mit der Unterschrift die eine Cursorposition nach unten geschoben wird. Zusätzlich habe ich noch "Objekt mit Text verschieben" angehakt, damit weiter oben im Dokument auch weitere Zeilen eingesetzt werden können.

Diese Einstellungen können sicher auch direkt im VBA-Script mit eingetragen werden, was die Sache nochmals erheblich vereinfachen würde.
In dieser Form müssen nämlich ca. 30 Dokumente angepaßt werden face-wink

LG
imebro
Mitglied: 37414
37414 Jan 21, 2015 updated at 10:36:26 (UTC)
Goto Top
Hmmm...

hat hier nochmal jemand von Euch einen Tipp, wie ich die Änderungen am Foto, die ich in dessen Einstellungen vornehmen muss, ins Script mit einbringen kann?
Und - auch eine Erklärung dafür, wieso das o.g. Script nur funktioniert, wenn der Code für "Abteilung" ÜBER dem Code für "i. A." steht?

Danke und Gruss,
imebro
Member: colinardo
colinardo Jan 21, 2015 updated at 10:57:12 (UTC)
Goto Top
Ich habe dir ja via PM angeboten zu helfen, aber wenn du darauf nicht antwortest ...
Mitglied: 37414
37414 Jan 21, 2015 at 11:29:54 (UTC)
Goto Top
Oh sorry, das habe ich nicht gesehen...
Schaue gleich mal nach.

LG
imebro
Mitglied: 37414
37414 Jan 22, 2015 updated at 09:07:35 (UTC)
Goto Top
Um diesen Thread hier nun zu beenden, stelle ich nun die gesamte Lösung hier ein.
Mit dem folgenden Code wird automatisiert ein Foto an eine bestimmte Stelle im Word-Dokument eingefügt.
Weiterhin wird weiterer Text (z.T. auch formatiert) unter diesem Foto eingefügt.
Das Foto wird mit verschoben, wenn weiter oben im Dokument weitere Zeilen... weiterer Text... eingefügt wird.
Am Ende erfolgt der Aufruf eines weiteren Makros (z.B. zum drucken).

==>> Besonderer Dank hier an "colinardo" face-smile

Hier der Code:

Sub Foto_und_Druck()
'  
    Dim img As InlineShape, posImage As Range, posAbteilung As Range, posImAuftrag As Range
    Selection.GoTo wdGoToPage, wdGoToFirst
    With ActiveDocument.Content.Find
        .Text = "Mit freundlichen Grüßen"  
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
        .Execute
        If .Found Then
            .Parent.InsertParagraphAfter
            .Parent.InsertParagraphAfter
            .Parent.InsertParagraphAfter
            .Parent.InsertParagraphAfter
            Set posImage = .Parent.GoTo(wdGoToLine, wdGoToNext, 1)
            posImage.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
            Set img = posImage.InlineShapes.AddPicture("C:\Users\name\Desktop\Foto.jpg")  
            Set posImAuftrag = posImage.GoTo(wdGoToLine, wdGoToNext, 1)
            With posImAuftrag
                .End = .Paragraphs(1).Range.End
                .Font.Name = Arial
                .Font.Size = 11
                .Text = "i. A."  
            End With
            
            Set posAbteilung = posImAuftrag.GoTo(wdGoToLine, wdGoToNext, 1)
            With posAbteilung
                .End = .Paragraphs(1).Range.End
                .Font.Name = Arial
                .Font.Size = 9
                .Text = "Abteilung"  
            End With
        End If
    End With
                Call drucken
End Sub

Schöne Grüße,
imebro