Private Sub Workbook_Open()
Dim oBar As CommandBar
Dim oCbo As CommandBarComboBox
Dim s As String
Set oBar = Application.CommandBars("Worksheet Menu Bar")
s = Application.CommandBars
If s = "" Then Exit Sub
Sheets(s).Activate
End Sub
Option Explicit
Public objCombo As Object
Sub CreateButton()
Dim cmdBar As CommandBar
Dim cbx As CommandBarComboBox
Dim Ws As Worksheet
Set cmdBar = Application.CommandBars("Worksheet Menu Bar")
With cmdBar
Set cbx = .Controls.Add(Type:=msoControlComboBox, before:=.Controls.Count + 1, temporary:= _
True)
Set objCombo = cbx
End With
With cbx
.BeginGroup = True
.OnAction = "Auswahl"
.TooltipText = "Blatt auswählen"
For Each Ws In ThisWorkbook.Worksheets
.AddItem Ws.Name
Next Ws
End With
End Sub
Sub deleteButton()
objCombo.Delete
End Sub
Sub Auswahl()
Worksheets(objCombo.Text).Activate
End Sub
Option Explicit
Private Sub Workbook_Open()
Call CreateButton
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call deleteButton
End Sub
Sub deleteButton()
On Error Resume Next
objCombo.Delete
End Sub
Function wksOK(sWksName As String) As Boolean
'returns True if the target wks exists
'returns False if the target wks does NOT exists
Dim wkb As Worksheet
On Error Resume Next
Set wkb = Sheets(sWksName)
On Error GoTo 0
wksOK = IIf(Not wkb Is Nothing, True, False)
End Function
Gruß
Klaus
Sub DateiÖffnen()
Dim lngCount As Long
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Show
For lngCount = 1 To .SelectedItems.Count
MsgBox .SelectedItems(lngCount)
Next lngCount
End With
End Sub
Private Sub SelectSheet()
Dim strSheet As String
On Error GoTo fehler
strSheet = Application.CommandBars.ActionControl.Text
ThisWorkbook.Sheets(strSheet).Activate
Exit Sub
fehler: MsgBox "Tabelle " & Sheets(strSheet) & " gibt es nicht!"
End Sub