Lieber xlKing und Gast97923,
habt vielen herzlichen Dank für Eure Hilfe. Ihr konnten mein Problem lösen, habt vielen Dank dafür! Vielen Dank für deine Mühen xlKing mit der Überbrückungslösung. Ehrlich gesagt habe ich sie nicht ausprobiert. Ich habe den Hinweis von Gast97923 noch eingebaut und dann ging es tatsächlich. Die Lösung war tatsächlich die Kombination aus beiden Antworten. Der grundlegende Code war korrekt, nur die Stelle mit paste musste noch modifiziert werden, so wie es Gast97923 geschrieben hat.
Warum der Code bei dir, xlKing funktioniert, bei mir aber nicht, kann ich mir tatsächlich auch nicht erklären. Vielleicht hast du jetzt mit der Lösung eine Idee, warum das so ist.
Damit hier im Forum aber auch die Lösung entsprechend vorhanden ist, folgt hier jetzt noch der Code, der bei mir funktioniert.
Sub WordStarten()
Set wd = CreateObject("Word.Application")
wd.Visible = True
Set doc = wd.documents.Add
With doc.Sections(1)
ActiveSheet.Shapes("Grafik 1").Copy
.Headers(1).Range.PasteSpecial DataType:=3
.Headers(1).Shapes(1).Top = 0
.Headers(1).Shapes(1).Height = .PageSetup.HeaderDistance
.Headers(1).Shapes(1).Left = .PageSetup.PageWidth - .PageSetup.LeftMargin - .PageSetup.RightMargin - .Headers(1).Shapes(1).Width + 71
ActiveSheet.Shapes("Grafik 2").Copy
.Footers(1).Range.PasteSpecial DataType:=3
.Footers(1).Shapes(2).Top = 0
.Footers(1).Shapes(2).Left = 0
.Footers(1).Shapes(2).Height = .PageSetup.FooterDistance
ActiveSheet.Shapes("Grafik 3").Copy
.Footers(1).Range.PasteSpecial DataType:=3
.Footers(1).Shapes(3).Height = .PageSetup.FooterDistance
.Footers(1).Shapes(3).Top = 0
.Footers(1).Shapes(3).Left = .PageSetup.PageWidth - .PageSetup.LeftMargin - .PageSetup.RightMargin - .Footers(1).Shapes(3).Width + 50
End With
End Sub
Vielen, vielen lieben Dank für Eure Hilfe!
|