Ich möchte Tabellen durch eingabe in über eine Inputbox öffnen.
Nach der Methode: Sheets("Tabelle").Select
Gebe ich in der Inputbox eine andere Tabelle an, so soll die geöffnet werden.
Gibt es hierzu eine Lösung?
Gruß
Thomas
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
Funktioniert aber nicht!!!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
Und in das Klassenmodul "DieseArbeitsmappe":Option Explicit
Private Sub Workbook_Open()
Call CreateButton
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call deleteButton
End Sub
VG, Boris
Sub deleteButton()
On Error Resume Next
objCombo.Delete
End Sub
VG, BorisFunction 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
Ansonsten schau mal unter Excel-Hilfe "Application.FileDialog" nach. Da gibts noch andere Möglichkeiten.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