eigene menüleiste aktualliesieren!

Private Sub Workbook_Open()
ModulDiverseFunktion.Tabelle_Option_einschalten
Dim SpalteSprache As Integer
Dim Text1 As String
Dim Text2 As String
Dim Text3 As String
Dim Text4 As String
Dim Text5 As String
Dim Text6 As String
Dim Text7 As String
Dim Text8 As String
Dim Text9 As String
Dim Text10 As String
If Worksheets("Optionen").Cells(1, 255).Value = 2 Then
SpalteSprache = 256
ElseIf Worksheets("Optionen").Cells(1, 255).Value = 1 Then
SpalteSprache = 255
End If
Text1 = Worksheets("Optionen").Cells(481, SpalteSprache)
Text2 = Worksheets("Optionen").Cells(482, SpalteSprache)
Text3 = Worksheets("Optionen").Cells(483, SpalteSprache)
Text4 = Worksheets("Optionen").Cells(484, SpalteSprache)
Text5 = Worksheets("Optionen").Cells(485, SpalteSprache)
Text6 = Worksheets("Optionen").Cells(486, SpalteSprache)
Text7 = Worksheets("Optionen").Cells(487, SpalteSprache)
Text8 = Worksheets("Optionen").Cells(488, SpalteSprache)
Text9 = Worksheets("Optionen").Cells(489, SpalteSprache)
Text10 = Worksheets("Optionen").Cells(490, SpalteSprache)
Text11 = Worksheets("Optionen").Cells(491, SpalteSprache)
Text12 = Worksheets("Optionen").Cells(492, SpalteSprache)
Text13 = Worksheets("Optionen").Cells(493, SpalteSprache)
Text14 = Worksheets("Optionen").Cells(494, SpalteSprache)
Text15 = Worksheets("Optionen").Cells(495, SpalteSprache)
Text16 = Worksheets("Optionen").Cells(496, SpalteSprache)
Text17 = Worksheets("Optionen").Cells(497, SpalteSprache)
Text18 = Worksheets("Optionen").Cells(498, SpalteSprache)
Text19 = Worksheets("Optionen").Cells(499, SpalteSprache)
Text20 = Worksheets("Optionen").Cells(500, SpalteSprache)
Text21 = Worksheets("Optionen").Cells(501, SpalteSprache)
Text22 = Worksheets("Optionen").Cells(502, SpalteSprache)
'******** Symbolleiste erzeugen ***********************************************'
Dim CB As CommandBar            ' Variable für Symbolleiste
Dim CBC As CommandBarButton     ' Variable für Button
Dim i As Integer                ' Variable für Schleife
On Error Resume Next
On Error Resume Next
Set CB = Application.CommandBars.Add(Name:=Text1, _
temporary:=True, Position:=msoBarTop)
' temporary:=True Symbolleiste ist flüchtig, wird beim schließen von
' Excel gelöscht
' Oben      Position:=msoBarTop
' Rechts    Position:=msoBarRight
' Links     Position:=msomsoBarLeft
' unten     Position:=msoBarBottom
If Err.Number <> 0 Then  ' Symbolleiste schon vorhanden
Application.CommandBars.Add(Name:=Text1).Visible = True
Exit Sub
End If
On Error GoTo 0
' If Application.CommandBars("FPC_Design").Visible = False Then
CB.Visible = True
'        Position der Symbolleiste vo Links
'CB.Left = 600
'        position der Symbolleiste von oben falls Position:=... nicht angegeben
CB.Top = 250
'       Wort mit Untermenü
On Error Resume Next
'       Menü löschen falls schon vorhanden
Application.CommandBars(Text1).Controls("Menü").Delete
On Error GoTo 0
With Application.CommandBars(Text1).Controls.Add(Type:=msoControlPopup)
.BeginGroup = True 'Trennlinie
On Error GoTo 0
.Caption = Text1
'           erster Menüpunkt
With .Controls.Add
.FaceId = 612
.Caption = Text2
.OnAction = "ModulSymbol.Hauptmenü"
End With
'           Zweiter Menüpunkt
With .Controls.Add
.BeginGroup = True 'Trennlinie
.FaceId = 71
.Caption = Text3
.OnAction = "ModulCoorErstellen.Tabelle_Coor_Erstellen"
End With
'          3. Menüpunkt
With .Controls.Add
.FaceId = 72
.Caption = Text4
.OnAction = "ModulSymbol.Header"
End With
'           Untermenü erzeugen:
'           vierter Menüpunktmit Untermenü
With .Controls.Add(Type:=msoControlPopup)
'               Trennlinie
.BeginGroup = True
.Caption = Text5
With .Controls.Add
.FaceId = 73
.Caption = Text5
.OnAction = "ModulSymbol.Dateneingabe"
End With
With .Controls.Add
.FaceId = 73
.Caption = Text7
.OnAction = "ModulSymbol.IPSTD"
End With
End With
'           Untermenü erzeugen:
'           sechster Menüpunktmit Untermenü
With .Controls.Add(Type:=msoControlPopup)
'               Trennlinie
.BeginGroup = True
.Caption = Text6
With .Controls.Add
.FaceId = 74
.Caption = Text8
.OnAction = "ModulSymbol.Berechnung"
End With
With .Controls.Add
.FaceId = 74
.Caption = Text9
.OnAction = "ModulSymbol.ohneBerechnung"
End With
End With
'           siebter Menüpunkt
With .Controls.Add
.BeginGroup = True 'Trennlinie
.FaceId = 75
.Caption = Text10
.OnAction = "ModulSymbol.Nullrechnen"
End With
'           Achter  Menüpunkt
With .Controls.Add
.FaceId = 76
.Caption = Text11
.OnAction = "ModulSymbol.layout1"
End With
'           Neunter  Menüpunkt
With .Controls.Add
.FaceId = 77
.Caption = Text12
.OnAction = "ModulSymbol.layout2"
End With
'zehnter Menüpunkt
With .Controls.Add
.FaceId = 78
.Caption = Text13
.OnAction = "ModulSymbol.zusatzseiten"
End With
'elfter Menüpunkt
With .Controls.Add
.FaceId = 79
.Caption = Text14
.OnAction = "ModulSpeichern.speichern_ohne_Makros"
End With
'           Untermenü erzeugen:
'           dritter Menüpunktmit Untermenü
With .Controls.Add(Type:=msoControlPopup)
'               Trennlinie
.BeginGroup = True
.Caption = Text15
With .Controls.Add
.FaceId = 47
.Caption = Text16
.OnAction = "ModulDel.Layout_delete"
End With
With .Controls.Add
.FaceId = 47
.Caption = Text17
.OnAction = "ModulSymbol.Coor_löschen"
End With
With .Controls.Add
.FaceId = 47
.Caption = Text18
.OnAction = "ModulSymbol.Header_löschen"
End With
With .Controls.Add
.FaceId = 47
.Caption = Text19
.OnAction = "ModulSymbol.Pad_löschen"
End With
With .Controls.Add
.FaceId = 47
.Caption = Text20
.OnAction = "ModulSymbol.CoorDaten_löschen"
End With
With .Controls.Add
.FaceId = 47
.Caption = Text21
.OnAction = "ModulDel.alle_nicht_wichtigen"
End With
End With
With .Controls.Add
.BeginGroup = True 'Trennlinie
.FaceId = 20
.Caption = Text22
.OnAction = "ModulSymbol.option_öffnen"
End With '
End With
ModulDiverseFunktion.neu_symbolleiste
End Sub

Private Sub Workbook_Deactivate()
'    Aktion beim Wechsel der Datei
'    Schaltflächen nicht auswählbar bei Daieiwechsel
'    Dim I as Byte
'    With Application.CommandBars("FPC_Design")
'        For I = 1 To 15
'            .Controls(I).Enabled = False
'        Next I
'    End With
'   Symbolleiste ausblenden bei Dateiwechsel
On Error Resume Next
If Application.CommandBars("FPC_Design").Visible = True Then
Application.CommandBars("FPC_Design").Visible = False
End If
End Sub

Private Sub Workbook_Activate()
'   Aktion bei aktivierung dieser Datei
On Error GoTo neu
If Application.CommandBars("FPC_Design").Visible = False Then
Application.CommandBars("FPC_Design").Visible = True
End If
Exit Sub
neu:
Workbook_Open
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
''   temporary:=false, Symbolleiste muß gelöscht werden
''   bei der jetzigen Variante wird die Symbolleiste
''   beim schliessen von Excel gelöscht
''   Aktion beim schliessen der Datei
'    On Error Resume Next
'    Application.CommandBars("FPC_Design").Delete
'End Sub

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Excel.Range)
'   Aktion bei Auswahl einer Zelle in dieser Datei
'   Symbolleiste einblenden falls Sie jemand ausgeblendet hat bzw.
On Error GoTo neu
If Application.CommandBars("FPC_Design").Visible = False Then
Application.CommandBars("FPC_Design").Visible = True
End If
Exit Sub
neu:
Workbook_Open
End Sub