Gruppe
Menue
Problem
Bei Blattwechsel sollen die Eintragungen in den jeweiligen Blattbereichen A1:E1 als Symbolleiste angelegt werden.
ClassModule: DieseArbeitsmappe
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("Tabelle1").Delete
Application.CommandBars("Tabelle2").Delete
Application.CommandBars("Tabelle3").Delete
On Error GoTo 0
End Sub
Private Sub Workbook_Open()
Call CreateCmdBar
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
On Error Resume Next
Select Case Sh.Name
Case "Tabelle1"
Application.CommandBars("Tabelle2").Delete
Application.CommandBars("Tabelle3").Delete
Call CreateCmdBar
Case "Tabelle2"
Application.CommandBars("Tabelle1").Delete
Application.CommandBars("Tabelle3").Delete
Call CreateCmdBar
Case "Tabelle3"
Application.CommandBars("Tabelle1").Delete
Application.CommandBars("Tabelle2").Delete
Call CreateCmdBar
End Select
On Error GoTo 0
End Sub
Sub CreateCmdBar()
Dim cmdBar As CommandBar
Dim cmdBtn As CommandBarButton
Dim iCounter As Integer
Set cmdBar = Application.CommandBars.Add(ActiveSheet.Name, _
msoBarTop, False, True)
For iCounter = 1 To 5
Set cmdBtn = cmdBar.Controls.Add
With cmdBtn
.Caption = ActiveSheet.Cells(1, iCounter).Value
.OnAction = ""
.Style = msoButtonCaption
End With
Next iCounter
cmdBar.Visible = True
End Sub