Public Sub CreateCommandBar()
  Dim objCBar     As Office.CommandBar
  Dim strOnAction As String

  DeleteCommandBar

  On Error GoTo err_CreateCommandBar

  Set objCBar = ThisWorkbook.Application.CommandBars.Add( _
          Name:=gcCBAR_NAME, Temporary:=True)

  strOnAction = "'" & ThisWorkbook.Name & "'!modOnAction."

  With objCBar
    .Controls.Add ID:=2520
    .Controls.Add ID:=23
    .Controls.Add ID:=3

    With .Controls.Add(Type:=msoControlButton)
      .BeginGroup = True
      .Style = msoButtonCaption
      .Caption = "Demo Button 1"
      .Tag = gcCBARBTN_TAG
      .OnAction = strOnAction & "OnAction_DemoAddIn_11"
    End With

    With .Controls.Add(Type:=msoControlButton)
      .Style = msoButtonCaption
      .Caption = "Demo Button 2"
      .Tag = gcCBARBTN_TAG
      .OnAction = strOnAction & "OnAction_DemoAddIn_12"
    End With

    With .Controls.Add(Type:=msoControlButton)
      .BeginGroup = True
      .Style = msoButtonIcon
      .FaceId = 3021
      .Parameter = "http://www.vb-fun.de"
      .TooltipText = "VB-fun-Startseite"
      .OnAction = strOnAction & "OnAction_GoToVBfun_13"

      On Error Resume Next
      TCBarPics.Shapes("picVBFun").CopyPicture
      If Err.Number = 0 Then
        .PasteFace
      End If
      On Error GoTo 0
    End With

    .Position = msoBarTop
    .Visible = True
    .Protection = msoBarNoCustomize
  End With

exit_Sub:
  On Error Resume Next
  Set objCBar = Nothing
  On Error GoTo 0
  Exit Sub

err_CreateCommandBar:
  MsgBox "Es ist ein Fehler bei der Erstellung der neuen " & _
          vbCrLf & "Symbolleiste aufgetreten !", vbCritical, _
          gcAPP_NAME & " - Fehler"
  DeleteCommandBar
  Resume exit_Sub
End Sub

Option Explicit
Option Private Module

Private Sub OnAction_DemoAddIn_11()
  MsgBox ThisWorkbook.Name
End Sub

HKEY_CURRENT_USER\Software\VB and VBA Program Settings\

  With objCBar
    .Width = CInt(GetSetting( _
           gcREG_APP, gcREG_TOOLBAR, "Width", .Width))
    .Position = CLng(GetSetting( _
           gcREG_APP, gcREG_TOOLBAR, "Position", msoBarTop))
    .Top = CLng(GetSetting(gcREG_APP, gcREG_TOOLBAR, "Top", .Top))
    .Left = CLng(GetSetting( _
           gcREG_APP, gcREG_TOOLBAR, "Left", .Left))
    .RowIndex = CLng(GetSetting( _
           gcREG_APP, gcREG_TOOLBAR, "RowIndex", .RowIndex))

    .Visible = CBool(GetSetting( _
           gcREG_APP, gcREG_TOOLBAR, "Visible", -1))
    .Protection = msoBarNoCustomize
  End With

Private Sub AddIn_SaveSettings()
  Dim objCBar     As Office.CommandBar
  Dim lngPosition As Long
  Dim blnVisible  As Boolean

  On Error Resume Next
  Set objCBar = ThisWorkbook.Application.CommandBars(gcCBAR_NAME)
  If Not objCBar Is Nothing Then
    With objCBar
      lngPosition = .Position
      blnVisible = .Visible

      SaveSetting gcREG_APP, gcREG_TOOLBAR, "Visible", _
            CLng(.Visible)
      SaveSetting gcREG_APP, gcREG_TOOLBAR, "Position", .Position
      SaveSetting gcREG_APP, gcREG_TOOLBAR, "Top", .Top
      SaveSetting gcREG_APP, gcREG_TOOLBAR, "Left", .Left
      SaveSetting gcREG_APP, gcREG_TOOLBAR, "RowIndex", .RowIndex

      .Visible = False
      .Position = msoBarFloating
      SaveSetting gcREG_APP, gcREG_TOOLBAR, "Width", .Width

      .Position = lngPosition
      .Visible = blnVisible
    End With
    Set objCBar = Nothing
  End If
  On Error GoTo 0
End Sub

Public Sub AddIn_DeleteRegSettings()
  On Error Resume Next
  DeleteSetting gcREG_APP
  On Error GoTo 0
End Sub

Public Function GetVisibleWkbWindows() As Long
  Dim objWnd   As Window
  Dim nWndsCnt As Long

  For Each objWnd In Application.Windows
    If objWnd.Visible = True Then
      nWndsCnt = nWndsCnt + 1
    End If
  Next
  GetVisibleWkbWindows = nWndsCnt
End Function

Sub OnAction_Demo()
  If GetVisibleWkbWindows > 0 Then
    '...
  End If
End Sub

Private WithEvents meXLAppl As Excel.Application

Private Sub Class_Initialize()
  Set meXLAppl = Excel.Application
End Sub

Private Sub ToggleCBarButtons(ByVal fEnable As Boolean)
  Dim objCBar   As Office.CommandBar
  Dim i         As Integer

  On Error Resume Next
  Set objCBar = ThisWorkbook.Application.CommandBars(gcCBAR_NAME)
  If Not objCBar Is Nothing Then 

    For i = 1 To objCBar.Controls.Count
      If InStr(1, objCBar.Controls(i).Tag, gcCBARBTN_TAG) > 0 Then
        objCBar.Controls(i).Enabled = fEnable
      End If
    Next

    Set objCBar = Nothing
  End If

  On Error GoTo 0
End Sub

Private Sub meXLAppl_WindowActivate(ByVal Wb As Workbook, _
      ByVal Wn As Window)
  ToggleCBarButtons True
End Sub

Private Sub meXLAppl_WindowDeactivate(ByVal Wb As Workbook, _
      ByVal Wn As Window)
  ToggleCBarButtons False
End Sub

Private Sub Class_Initialize()
  Set meXLAppl = Excel.Application
  ToggleCBarButtons CBool(GetVisibleWkbWindows > 0)
End Sub

  With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .EnableEvents = True
    .EnableCancelKey = xlInterrupt
    .Cursor = xlDefault
  End With

Private Sub AddIn_GetSettings()
  #If VBA6 Then
    Dim blnShowDialog As Boolean

    blnShowDialog = CBool(GetSetting( _
          gcREG_APP, gcREG_STARTUP, "ShowDialog", -1))

    If blnShowDialog = True Then
      Dim strMsg    As String
      Dim frmDialog As FrmStartup

      strMsg = "Für dieses Add-In muss die Option " & _
               "'Fenster in Taskleiste' im " & _
               "Menü Extras / Optionen... / Ansicht " & _
               "deaktiviert werden." & vbCrLf & vbCrLf

      If Application.ShowWindowsInTaskbar = True Then
        strMsg = strMsg & "> Die Option wird bei OK deaktiviert! <"
      Else
        strMsg = strMsg & "> Die Option ist bereits deaktiviert! <"
      End If

      Set frmDialog = New FrmStartup
      With frmDialog
        .gInit = True
        .gMessage = strMsg
        .Show
        DoEvents
        SaveSetting gcREG_APP, gcREG_STARTUP, "ShowDialog", _
              CLng(.gShowDialog)
      End With
      Unload frmDialog
      Set frmDialog = Nothing
    End If
    Application.ShowWindowsInTaskbar = False
  #End If
End Sub

Private Sub Workbook_AddinInstall()
  '...
End Sub

Private Sub Workbook_Open()
  AddIn_Initialize
End Sub

Public Sub AddIn_Initialize()
  CreateCommandBar
  AddIn_GetSettings
  If gCAppEvents Is Nothing Then
    Set gCAppEvents = New CAppEvents
  End If
End Sub

Private Sub Workbook_AddinUninstall()
  m_blnAddInUninstall = True
  AddIn_Uninstall
End Sub

Public Sub AddIn_Uninstall()
  AddIn_Terminate

  If MsgBox("Sollen die Registry-Einträge für dieses " & _
        "Add-In gelöscht werden?", vbYesNo + vbQuestion, _
        gcAPP_NAME) = vbYes Then
    AddIn_DeleteRegSettings
  End If

  DeleteCommandBar
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  If Not m_blnAddInUninstall Then
    AddIn_Terminate
    If Application.Workbooks.Count > 0 Then
      Application.OnTime Now, "'" & ThisWorkbook.Name & _
            "'!AddIn_OnShutdown"
    End If
  End If
End Sub

Public Sub AddIn_Terminate()
  Set gCAppEvents = Nothing
  AddIn_SaveSettings
End Sub

Public Sub AddIn_OnShutdown()
  If gCAppEvents Is Nothing Then
    Set gCAppEvents = New CAppEvents
  End If
End Sub

Private Function HasDocProperty(Optional ByRef Wb As Workbook) _
      As Boolean

  Dim varDPValue As Variant

  On Error Resume Next
  If Wb Is Nothing Then
    Set Wb = Application.ActiveWorkbook
  End If

  If Not Wb Is Nothing Then
    varDPValue = Trim$(Wb.CustomDocumentProperties(gcAPP_NAME))

    If varDPValue = gcAPP_VERSION Then
      HasDocProperty = True
    End If
  End If

exit_Func:
  On Error GoTo 0
End Function

Private Sub meXLAppl_WindowActivate(ByVal Wb As Workbook, _
      ByVal Wn As Window)
  ToggleCBarButtons HasDocProperty(Wb)
End Sub

Public Function IsTemplateWorkbook() As Boolean
  On Error Resume Next
  ToggleCBarButtons False

  If GetVisibleWkbWindows > 0 Then
    If HasDocProperty() Then
      ToggleCBarButtons True
      IsTemplateWorkbook = True
    End If
  End If
  On Error GoTo 0
End Function

Private Sub Class_Initialize()
  Set meXLAppl = Excel.Application
  IsTemplateWorkbook
End Sub

Public Sub OnAction_Demo()
  If gCAppEvents.IsTemplateWorkbook Then
    MsgBox "Tue 'was ;-)", vbExclamation, gcAPP_NAME
  End If
End Sub

Private Sub Workbook_Open()
  AddIn_Initialize
End Sub

Private Sub Workbook_Open()
  Application.OnTime Now, "'" & ThisWorkbook.Name & _
        "'!AddIn_Initialize"
End Sub

Private Sub Workbook_Open()
  'Zum Testen
  On Error Resume Next
  MsgBox "Name der aktiven Arbeitsmappe im Open-Ereignis: " & _
          ActiveWorkbook.Name
  On Error GoTo 0
End Sub