Option Explicit

Sub BriefkopfAus()
    HideBriefkopf (True)
End Sub

Sub BriefkopfEin()
    HideBriefkopf (False)
End Sub

Private Sub HideBriefkopf(OnOff As Boolean)
ActiveDocument.Styles("Kopfzeile").Font.Hidden = OnOff
End Sub
'Grafiken in Kopf und Fußzeilen einfügen
Sub Briefkopf()

Dim wdAppl As Word.Application
Dim wdDoc As Word.Document
Dim wdRng As Word.Range
Dim wdTab As Word.Table
Dim ishp As Word.InlineShape
Dim oFileDialog As FileDialog
Dim StrFirst$, StrFolge$, vItem$

Set wdAppl = Word.Application
Set wdDoc = wdAppl.ActiveDocument
'Seite 1 zu alle anderen unterschiedlich
wdDoc.PageSetup.DifferentFirstPageHeaderFooter = True
'Nur Erste Seite der Section
Set wdRng = wdDoc.Sections(1).Headers(wdHeaderFooterFirstPage).Range
'Grapic in Seite 1
Set oFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    With oFileDialog
        .InitialView = msoFileDialogViewThumbnail
        .InitialFileName = "C:\_alter Server\1_Tabellen etc\4_Logos\"
        .Title = "Bitte Grafik für die erste Seite auswählen"
        .ButtonName = "FIRST"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Bilder", "*.png;*.gif;*.jpg", 1
        If .Show = -1 Then
            StrFirst = .SelectedItems(1)
        End If
    End With
'gewähltes Bild einfügen
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.InlineShapes.AddPicture StrFirst
ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range.InlineShapes(1).ConvertToShape
With ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Shapes(1)
    .Height = ActiveDocument.PageSetup.PageHeight
    .Width = ActiveDocument.PageSetup.PageWidth
End With
''die anderen Seiten
Set wdRng = wdDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range
''Grapic alle anderen seiten
Set oFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    With oFileDialog
        .InitialView = msoFileDialogViewThumbnail
        .InitialFileName = "C:\_alter Server\1_Tabellen etc\4_Logos\"
        .Title = "Bitte Grafik für die folgenden Seite auswählen"
        .ButtonName = "NEXT"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Bilder", "*.png;*.gif;*.jpg", 1
        If .Show = -1 Then
            StrFolge = .SelectedItems(1)
        End If
    End With
Set ishp = wdRng.InlineShapes.AddPicture(StrFolge, _
LinkToFile:=False, SaveWithDocument:=True, Range:=wdRng)
ishp.ConvertToShape
'optionale Formatierungen
With wdRng.Sections(1).Headers(wdHeaderFooterPrimary).Shapes(1)
.Height = wdDoc.PageSetup.PageHeight
.Width = wdDoc.PageSetup.PageWidth
'.Left = CentimetersToPoints(-2.5)
'.Top = CentimetersToPoints(-1.25)
End With
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

'Bilder aus dem Kopf- und Fußzeilen löschen
Sub DeleteHeaderShapes()
Dim h As HeaderFooter
Dim i As Integer, ret As Integer
Set h = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
If h.Shapes.Count > 0 Then
  For i = 1 To 1
  If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
    ActivePane.View.Type = wdOutlineView Then
    ActiveWindow.ActivePane.View.Type = wdPrintView
  End If
  ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    h.Shapes(i).Select
    ret = MsgBox("Grafik löschen?", vbYesNoCancel)
    Select Case ret
    Case vbCancel
      Exit Sub
    Case vbYes
      h.Shapes(i).Delete
    End Select
  Next i
End If
Set h = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage)
If h.Shapes.Count > 0 Then
  For i = 1 To 1
  If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
    ActivePane.View.Type = wdOutlineView Then
    ActiveWindow.ActivePane.View.Type = wdPrintView
  End If
  ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    h.Shapes(i).Select
    ret = MsgBox("Grafik löschen?", vbYesNoCancel)
    Select Case ret
    Case vbCancel
      Exit Sub
    Case vbYes
      h.Shapes(i).Delete
    End Select
  Next i
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub