Option Explicit
'Variablen deklarierung
Dim Kopf1A, Kopf1B As Range
'AutoTextEntry Schlüssel für Logo Schwarz Weiss
Dim schwarz_weiss As String
'AutoTextEntry Schlüssel für Logo farbig
Dim farbig As String
 
'Globale Variable für Toggle (True/False)
Dim Pointer As Boolean
 
'Callback for BlankPageButton onAction
Public Sub RibbonXOnAction(control As IRibbonControl)
 
    'Hier Schwarz_weiss und farbig definieren
    schwarz_weiss = "bundeslogo_sw"
    farbig = "bundeslogo_col"
 
    'IIF gibt falls Pointer = True schwarz_weiss zurück, sonst farbig
    BundLogo_Toggle IIf(Pointer, schwarz_weiss, farbig)
 
    'Toggle, falls True, auf False setzten usw.
    Pointer = Not Pointer
 
End Sub
 
Public Sub BundLogo_Toggle(SelectAutoTextEntry As String)
  Dim CellRange As Range
  Dim TableRange As Range
  'In die Kopfzeilen Ansicht des Dokuments wechseln
   ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
 
 
  'Prüfen ob es eine Tabelle im Header gibt
  If ActiveDocument.Sections(1).Headers(1).Range.Tables.Count >= 1 Then
  'Es besteht eine Tabelle im Header, Prüfen ob sich in der Tabelle ein 
  ' Autotext Eintrag befindet
          Set CellRange = ActiveDocument.Sections(1).Headers(1).Range.Tables( _
            1).Cell(1, 1).Range
 
        SetAutoTextEntryInTable SelectAutoTextEntry
 
     Selection.Borders.OutsideLineStyle = wdLineStyleNone
     Selection.Borders.InsideLineStyle = wdLineStyleNone
 
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
 
  Else
          Set TableRange = ActiveDocument.Sections(1).Headers(1).Range
          'Es befindet sich keine Tabelle im Header, Tabelle erstellen
          SetTable TableRange, 1, 2
 
          Set CellRange = ActiveDocument.Sections(1).Headers(1).Range.Tables( _
            1).Cell(1, 1).Range
 
        SetAutoTextEntryInTable SelectAutoTextEntry
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
 
 
 
 
  End If
End Sub
 
Private Sub SetAutoTextEntryInTable(SelectAutoTextEntry As String)
           'Variablen deklarierung
            Dim Kopf1A, Kopf1B As Range
 
            Dim SetAutoTextEntry As Boolean
            SetAutoTextEntry = False
 
 
 
            'Der Varialble Kopf1A wird die KopfZeile des Dokuments als gewählte 
            ' Sektion angegeben
            Set Kopf1A = ActiveDocument.Sections(1).Headers( _
              wdHeaderFooterPrimary).Range
 
            Dim xDoc As Document
            Set xDoc = ActiveDocument
 
            Dim xEntry As autoTextEntry
 
 
            For Each xEntry In xDoc.AttachedTemplate.AutoTextEntries
                If xEntry.Name = SelectAutoTextEntry Then
                    SetAutoTextEntry = True
                    Exit For
                Else
                    SetAutoTextEntry = False
                End If
            Next xEntry
 
 
        If SetAutoTextEntry Then
            'Dem Dokument wird im Definierten Bereich den Schnellbaustein 
            ' "bundeslogo_col" eingefügt
            ActiveDocument.AttachedTemplate.AutoTextEntries( _
              SelectAutoTextEntry).Insert Where:=Kopf1A, RichText:=True
        Else
            MsgBox ("Der Textbaustein wurde nicht gefunden")
        End If
End Sub
 
 
 
 
 
 
 
 
Private Sub SetTable(ByVal Position As Range, RowCount As Integer, ColumnCount _
  As Integer)
 
    ActiveDocument.Tables.Add Range:=Position, NumRows:=RowCount, _
      NumColumns:=ColumnCount, DefaultTableBehavior:=wdWord9TableBehavior, _
      AutoFitBehavior:=wdAutoFitFixed
    With Selection.Tables(1)
        If .Style <> "Tabellengitternetz" Then
            .Style = "Tabellengitternetz"
        End If
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .ApplyStyleRowBands = True
        .ApplyStyleColumnBands = False
    End With
 
    Position.Tables(1).Select
 
    Position.Borders.OutsideLineStyle = wdLineStyleNone
     Position.Borders.InsideLineStyle = wdLineStyleNone
  End Sub
 
 
 
Public Sub OnGetLabel(control As IRibbonControl, ByRef label)
    Select Case Application.LanguageSettings.LanguageID(msoLanguageIDUI)
            Case msoLanguageIDGerman: label = "Logo wechseln"
            Case msoLanguageIDFrench: label = "Changer logiciel"
            Case msoLanguageIDItalian: label = "Cambiare logo"
            Case msoLanguageIDEnglishUS: label = "Change logo"
    End Select
End Sub