AW: Hilfe bei Listenfeld aus Toolbar
07.05.2005 09:56:40
Ramses
Hallo
Bei VBA-Gut solltest du damit was anfangen können:
Option Explicit
'Created by (C) Ramses
'--------
'Const myName As String = "Menüleiste by Ramses"
'Const myDropName As String = "Auswahl"
Sub Create_Window_Control()
Dim myCB As CommandBar
Dim mycbb As CommandBarControl
Dim i As Integer
Dim myName As String
Dim myDropName As String
myName = "MyField"
myDropName = "Tabellenliste"
On Error Resume Next
'Vorsichtshalber eine existierende löschen
Application.Commandbars(myName).Delete
'Neue eigene Symbolleiste erstellen
'myName für die Bezeichnung
'msoBarTop platziert die Leiste oberhalb des Sheets
Set myCB = Application.Commandbars.Add(name:=myName, _
temporary:=True, Position:=msoBarTop)
On Error GoTo 0
'DropDown Feld hinzufügen
Set mycbb = Application.Commandbars(myName).Controls.Add _
(Type:=msoControlDropdown)
With mycbb
'Beschreibung
.Caption = myDropName
'Breite
.Width = 140
'Eigene Gruppe erstellen
.BeginGroup = True
'Makro das ausgeführt wird
'wenn ein Eintrag ausgewählt wird
.OnAction = "Control_Action"
'Hinzufügen von allen offenen Mappen
'ins DropDownfeld ausser der "PERSONL.XLS"
For i = 1 To Application.Workbooks.count
If Application.Workbooks(i).name <> "PERSONL.XLS" Then
.AddItem Application.Workbooks(i).name
End If
Next i
.ListIndex = 1
End With
myCB.Visible = True
Set myCB = Nothing
Set mycbb = Nothing
End Sub
'Gehört zum erstellen der Menüleiste
'"Create_Window_Control()" als ActionTeil
'wenn ein eintrag activiert wird
Sub Control_Action()
'by GrafFri
Dim cbc As Object
Set cbc = Commandbars.ActionControl
Workbooks(cbc.Text).Activate
End Sub
Sub Delete_Dropdown_MenuItem()
'
Sub Delete_Dropdown_MenuItem(ItemName As String)
'(C) Ramses
'entfernt den entsprechenden
'Fenster Eintrag aus der Menüleiste
'"Create_Window_Control()"
Dim mycbb As Object
Dim i As Long
Set mycbb = Application.Commandbars(myName).Controls(myDropName)
For i = 1 To mycbb.ListCount
'Mappe3 ist ein Beispielname
'Es kann auch mit
' Delete_Dropdown_MenuItem(ActiveWorkbook.Name)
'oder
' Delete_Dropdown_MenuItem("Mappe3.xls")
'aufgerufen werden
If mycbb.List(i) = "Mappe3.xls" Then
mycbb.RemoveItem (i)
Exit Sub
End If
Next i
End Sub
'****************************************************************
'****************************************************************
'****************************************************************
"...Dessweiteren bräuchte ich auch noch eine Lösung für den Rückgabewert, dieser sollte dann möglicst auch in Werte geschrieben werden und nicht in Eingabe...."
Diese Frage entspricht aber nicht gerade deinem VBA-Level ;-)
Gruss Rainer