Hi Mike,

Also das kann ich mir überhaupt nicht erklären, warum das bei dir nicht klappt. Bei mir funktioniert der Code einwandfrei. Habe mal deinem Wunsch das erst ins Dokument zu kopieren und erst später in die Kopf und Fußzeile zu kopieren entsprochen. Glaube aber nicht wirklich, dass das bei dir erfolgreicher ist. Bei mir klappts ebenfalls super, auch wenn der Code jetzt nicht mehr ganz so elegant ist. Probiers einfach mal aus.

Sub WordStarten2()

  Const wdPaneNone = 0, wdNormalView = 1, wdOutlineView = 2, wdPrintView = 3
  Const wdSeekCurrentPageHeader = 9, wdSeekCurrentPageFooter = 10, wdSeekMainDocument = 0
  

  Set wd = CreateObject("Word.Application")
  wd.Visible = True
  
  Set doc = wd.documents.Add
    
  If wd.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
    wd.ActiveWindow.Panes(2).Close
  End If
  If wd.ActiveWindow.ActivePane.View.Type = wdNormalView Or wd.ActiveWindow. _
    ActivePane.View.Type = wdOutlineView Then
    wd.ActiveWindow.ActivePane.View.Type = wdPrintView
  End If
    
    
  With doc.content
    ActiveSheet.Shapes("Grafik 1").Copy
    .Paste
  
    With doc.Shapes(1)
      .Height = wd.CentimetersToPoints(2)
      .Top = wd.CentimetersToPoints(0.5) - doc.PageSetup.TopMargin
      .Left = doc.PageSetup.PageWidth - .Width - doc.PageSetup.LeftMargin - wd.CentimetersToPoints(0.5)
      .Select
      wd.Selection.Copy
      .Delete
    End With
  
    wd.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    wd.Selection.Paste
    
    
    
    wd.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    ActiveSheet.Shapes("Grafik 2").Copy
    .Paste
    With doc.Shapes(1)
      .Height = wd.CentimetersToPoints(2)
      .Top = doc.PageSetup.pageheight - .Height - wd.CentimetersToPoints(0.5)
      .Left = wd.CentimetersToPoints(0.5) - doc.PageSetup.LeftMargin
      .Select
      wd.Selection.Copy
      .Delete
    End With
    wd.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    wd.Selection.Paste
    wd.Selection.ShapeRange.Top = wd.Selection.ShapeRange.Top - wd.CentimetersToPoints(0.5)
    
    
    wd.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    ActiveSheet.Shapes("Grafik 3").Copy
    .Paste
    With doc.Shapes(1)
      .Height = wd.CentimetersToPoints(2)
      .Top = doc.PageSetup.pageheight - .Height - wd.CentimetersToPoints(0.5)
      .Left = doc.PageSetup.PageWidth - .Width - doc.PageSetup.LeftMargin - wd.CentimetersToPoints(0.5)
      .Select
      wd.Selection.Copy
      .Delete
    End With
    wd.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    wd.Selection.Paste
    wd.Selection.ShapeRange.Top = wd.Selection.ShapeRange.Top - wd.CentimetersToPoints(0.5)
    
    wd.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    
  End With
  
End Sub

Gruß Mr. K.