PDA

Vollständige Version anzeigen : Bild in Tabelle in Kopfzeile einfügen


Lichtwelle
26.09.2019, 14:04
Hallo,

von Excel VBA heraus möchte ich Word steuern, sodass es eine neue Textdatei erstellt und in die Kopfzeile ein Bild einfügt.

Zur Klarstellung:
- das Bild ("Logo") ist in Excel auf einem Blatt (auch "Logo") abgespeichert und wurde auch so genannt (klickt man das Bild an, erscheint der Name Logo im Namenfeld, oben links).
- das Bild muss sehr weit rechts eingefügt werden. Zu diesem Zweck füge ich eine Tabelle ein und mache sie sehr breit, um den rechten Seitenrand weiter zu schieben. Ich könnte das generell für die Seite machen aber dann gilt diese dünne Marge für den ganzen Text, was nicht gewollt ist. Also bleibt nur der Kopfzeilenbereich so breit.

Anbei der benutzte Code:


Dim WordDoc2 As Object
Dim Kopfzeile As Object
Dim WordTabelle2 As Object

Set WordDoc2 = ObjWord.ActiveDocument
Set Kopfzeile = WordDoc2.sections(1).headers(1).Range
Set WordTabelle2 = WordDoc2.Tables.Add(Kopfzeile, 1, 2)

Kopfzeile.ParagraphFormat.Alignment = 2

With WordTabelle2
.Cell(1, 1).SetWidth ColumnWidth:=10 * 28.35, RulerStyle:=0
.Cell(1, 2).SetWidth ColumnWidth:=5.7 * 28.35, RulerStyle:=0
.Cell(1, 2 ).Pictures.Insert (Worksheets("Logo")"Logo")
End With


Dieser Code führt systematisch zum Laufzeitfehler 438: Objekt unterstützt diese Eigenschaft oder Methode nicht. Problematisch ist die letzte Zeile.

Was wäre der richtige Code? Ich habe schon einiges ausprobiert aber alles führt zum gleichen Laufzeitfehler...

Im Voraus danke für eure Hilfe.

ReginaR
26.09.2019, 17:52
Hi,
auf die Bilder in einen Worksheet greifst Du über die Shapes-Auflistung zu. Müsste also so funktionieren:

Worksheets("Logo").Shapes.Range(Array("Logo"))

Lichtwelle
27.09.2019, 15:36
Hi Regina,

Danke für deine Antwort. Es funktioniert leider nicht. Aber vielleicht habe ich deinen Code-Auszug falsch eingebaut. Ich habe das geschrieben:

With WordTabelle2
.Cell(1, 2).Pictures.Insert (Worksheets("Logo").Shapes.Range(Array("Logo")))
End With

So bekomme ich die gleiche Fehlermeldung (Laufzeitfehler 438: Objekt unterstützt diese Eigenschaft oder Methode nicht).

Eine Idee, wie es genau sein soll? Danke im Vorfeld.

ReginaR
27.09.2019, 16:29
Hi,
der Zugriff auf das Logo sollte so funktionieren. Ich weiß aber nicht, on man in Word mit Pictures.Insert ein Bild in eine Tabelle einbauen kann. IntelliSence gibt das so nicht her. Evtl. liegt da das Problem.

Gerhard H
27.09.2019, 18:32
Hallo zusammen,

ich bin auch dafür dass der Fehler auf der Word-Seite liegt. Ich kenne jedenfalls kein picture.insert. Was ich kennen würde, wäre ein inlineshapes.AddPicture, was aber als Parameter eine Pfadangabe zum Bild verlangt, die du ja offenbar nicht hast, da du das Bild direkt aus Excel einfügen willst.

Deshalb hab ich es mit Copy und Paste probiert, wobei mir die Identifizierung des Bildes recht einfach gelungen ist:

Sub kopiersRueber()
Dim wrdApp As Object, wrdDoc As Object, wrdKopf As Object
Dim wrdTabelle As Object, wrdZelle As Object

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True

Set wrdDoc = wrdApp.documents.Add
Set wrdKopf = wrdDoc.sections(1).headers(1).Range
Set wrdTabelle = wrdDoc.tables.Add(wrdKopf, 1, 2)
Set wrdZelle = wrdTabelle.cell(1, 2).Range

Worksheets(1).Shapes("Logo").Select
Selection.Copy
wrdZelle.Paste

End Sub

Dieser Code ist in der angehängten Mappe enthalten.

Lichtwelle
27.09.2019, 19:49
Vielen Dank euch beiden für eure Antwort. Ich probiere das am Montag im Büro und melde mich dann. Schönes Wochenende.

Lichtwelle
30.09.2019, 13:31
Hi Gerhard,

ich habe deinen Code probiert, funktioniert leider nicht.

Wenn ich deine Datei aufmache und das Makro startet, kommt die Fehlermeldung "Laufzeitfehler '-2147417851 (80010105)': Die Methode 'Paste' für das Objekt 'Range' ist fehlgeschlagen".

Wenn ich ihn in mein Programm einbaue, dann wird ein 2. leeres Word Dokument erstellt und es wird dort eine Tabelle eingebaut aber es kommt kein Logo drin... Eine Idee, woran es liegen könnte?

Gerhard H
01.10.2019, 13:23
Hallo lichtwelle,

bei mir macht das Makro was verlangt war:

Es erstellt ein neues Dokument, fügt in dessen Kopfzeile eine zweispaltige Tabelle ein und kopiert die Grafik mit dem Namen "Logo" aus der Excelmappe in die zweite Spalte der Word-Tabelle.

Warum das bei dir nicht geht, versteh ich nicht. Hast du irgendwas geändert?

Lichtwelle
01.10.2019, 20:17
Komisch... Ich habe noch soeben probiert mit deiner Datei (also nicht mal deinen Text in meinen Code eingeben sondern deine Datei unverändert so mal nehmen) und bekomme die gleiche Fehlermeldung. Die Zeile mit "wrdzelle.Paste" schmeckt meinem Rechner nicht. :( Keine Ahnung, woran es liegen mag. :confused:

Trotzdem Danke für deine Mühe.

ReginaR
01.10.2019, 21:13
Hallo,
@ gerhardt: Ich habe deine Datei eben interessehalber auch mal getestet und kann das Testergebnis von Lichtwelle bestätigen. Der Paste-Befehl führt zum Fehler.
Ich arbeite mit Office 365

Luschi
02.10.2019, 07:28
Hallo Word-Fan's

bei mir klappt Gerhards Makro so (Word 2013/2019):Sub kopiersRueber()
Dim wrdApp As Object, wrdDoc As Object, wrdKopf As Object
Dim wrdTabelle As Object, wrdZelle As Object

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True

Set wrdDoc = wrdApp.documents.Add
Set wrdKopf = wrdDoc.sections(1).headers(1).Range
Set wrdTabelle = wrdDoc.tables.Add(wrdKopf, 1, 2)
Set wrdZelle = wrdTabelle.cell(1, 2).Range

ThisWorkbook.Worksheets(1).Shapes("Logo").Select
Excel.Selection.Copy
wrdZelle.Select
wrdApp.Selection.Paste

Set wrdApp = Nothing: Set wrdDoc = Nothing: Set wrdKopf = Nothing
Set wrdTabelle = Nothing: Set wrdZelle = Nothing

End SubGruß von Luschi
aus klein-Paris

ReginaR
02.10.2019, 08:10
@ Luschi:... ist ja spannend, hatte ich auch so probiert, läuft bei mir nicht, bekomme bei Deinem Code die Meldung:
Die Operation Paste für das Objekt Selection ist fehlgesschlagen

Ist zwar nicht meinen Baustelle, aber trotzdem eigenartig

Gerhard H
02.10.2019, 09:24
Hallo zusammen,

auf Excel.Selection.Copy wäre ich nie gekommen, da das Makro ja immerhin in Excel läuft.

Bei mir funktioniert es mit oder ohne Excel. Die folgende Version,die ich eigentlich ablehnen würde, funktioniert in meinem Word 2010 auch; vielleicht sogar in allen Versionen? Ich kann nur in 2010 testen.

Sub kopiersRueber2()
Dim wrdApp As Object, wrdDoc As Object, wrdKopf As Object

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True

Set wrdDoc = wrdApp.documents.Add
Set wrdKopf = wrdDoc.sections(1).headers(1).Range
wrdDoc.tables.Add wrdKopf, 1, 2

Worksheets(1).Shapes("Logo").Select
Excel.Selection.Copy
wrdDoc.Activate 'brauchts nicht, schadet aber auch nicht
wrdDoc.sections(1).headers(1).Range.tables(1).cell(1, 2).Range.Paste

End Sub

ReginaR
02.10.2019, 10:42
Hallo Gerhard, in Word 365 läuft das nicht:

Paste für Objekt Range fehlgeschlagen

merkwürdig ....

Gerhard H
02.10.2019, 10:55
Jetzt bin ich ja echt gespannt, was die Lichtwelle für Office-Version hat.

Und, @lichtwelle, wär es für dich ggf. eine Alternative, in der Exceltabelle eine Zelle mit dem Pfad zum Logo zu haben, statt oder zusätzlich zum Bild selber?

Dann könnte man noch eine Version mit InlineShapes.AddPicture probieren.

ReginaR
02.10.2019, 11:18
... habe eben ochmal experimentiert.
Word stürzt bei mit nach dem Paste sogar ab!

Es liegt irgend wie an der Tabelle in der Kopfzeile. Lasse ich die weg und füge das Bild einfach nur in die Kopfzeile ein, ist alles gut

ReginaR
02.10.2019, 11:19
.....

ReginaR
02.10.2019, 11:36
... und noch ein Nachtrag:
Lässt man die datei nach dem Absturz wieder herstellen, ist das Bild in der Tabellenzelle ....

Gerhard H
02.10.2019, 11:51
Mein letzter Versuch (funktioniert in Word 2010). Wenn du nochmal Lust zum Testen hast, Regina:
Sub kopiersRueber3()
Dim wrdApp As Object, wrdDoc As Object, wrdKopf As Object
Dim wrdTabelle As Object, wrdZelle As Object

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True

Set wrdDoc = wrdApp.documents.Add
Set wrdKopf = wrdDoc.sections(1).headers(1).Range
Set wrdTabelle = wrdDoc.tables.Add(wrdKopf, 1, 2)

Worksheets(1).Shapes("Logo").Select
Selection.Copy

Set wrdZelle = wrdTabelle.cell(1, 2).Range
wrdZelle.collapse Direction:=1
wrdZelle.Paste

End Sub

ReginaR
02.10.2019, 12:33
BINGO!
Das läuft! Collapse hatt cih auch schon versucht (ein wenig habe ich mir ja von Dir schon abgeguckt), aber Direction=1 hatte ich nicht

Word ist schon manchmal komisch :)

Lichtwelle
04.10.2019, 21:42
Hi Alle,

Danke für eure Antworten. Ist irgendwie doof, dass ich das erst jetzt sehe. Schade, dass ich keine Meldung bekomme, wenn eine neue Antwort gepostet wird.

Gerhard, ich hatte dein Makro in Office 2019 probiert, hat nicht funktioniert (dowload im Büro ist nicht einfach; besser den Code selbst tippen). Im Büro habe ich Office 2016.

Ich probiere den Code von Luschi und den letzten von Gerhard am Montag im Büro. Ich melde mich dann.

Vielen Dank und schönes Wochenende.

Lichtwelle
04.10.2019, 21:55
Ich habe übrigens Luschis Code und den von Gerhard probiert und es klappt aus welchem Grund auch immer nicht (mit Office 2019). Verstehe ich nicht.

Gerhard H
04.10.2019, 23:03
Hallo Lichtwelle,

nur noch mal zur Klarheit:

Du testest die Codes aus den Beiträgen 11 und 19 anhand der im Beitrag 5 angehängten Mustermappe? Wenn nein, zeig doch mal deine eigene Mappe und das Logo darin her.
Du lässt unbeschadet der Tatsache, dass du den Code eigentlich auf ein bestehendes Word-Dokument anwenden willst (Set WordDoc2 = ObjWord.ActiveDocument), ein neues Word-Dokument erstellen (Set wrdDoc = wrdApp.documents.Add)? Wenn nein, zeig doch mal dein Dokument her.
Du kriegst in allen Fällen immer die gleiche Fehlermeldung?

ReginaR
05.10.2019, 12:42
@Lichtwelle:. Du kannst im "Kontrollzentrum" in deinem Profil einstellen, dass Du über neue beiträge in den Unterhaltungen, in denen Du aktiv bist, benachrichtigt wirst.

Lichtwelle
08.10.2019, 20:29
Hallo,

ich habe die Datei vom Büro genommen und den Code vom Post 11 und vom Post 19 in mein Makro eingebaut. Es kommt keine Fehlermeldung aber das Logobild wird gar nicht in Word eingefügt.

Dann habe ich die Datei von Gerhard heruntergeladen und den Code vom Post 19 in das Makro eingefügt. Es kommt die beigefügte Fehlermeldung. Klicke ich auf "Debuggen", ist die letzte Zeile des Codes gelb markiert (wrdZelle.Paste), also hat Excel-VBA dort ein Problem.

Ich habe Office 2019 aber macht es etwas aus?

Übrigens, ich kann die Datei nicht hochladen. Es ist sehr vertraulich und sehr umfangreich (19.100 Zeilen), sodass die Fehlersuche nicht gerade einfach wäre.

Es ist aber nicht schlimm, wenn es nicht klappt. Es wäre ein nice to have feature aber kein must have.

Vielen Dank für eure Hilfe. Es ist echt super, wie ihr euch ins Zeug legt.