AW: Ärger mit eigener Symbolleiste
Ramses
Hallo
Tut mir leid, das zu reproduzieren ist mir zu aufwändig.
Probiers mal damit
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, myDropName As String
Dim datTyp As String, datName As String
myName = "MyField"
myDropName = "Tabellenliste"
datTyp = "xl"
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 aller Tabellennamen
datName = Dir("C:\*." & datTyp & "?")
Do While datName <> ""
.AddItem datName
datName = Dir()
Loop
'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
.Width = 80
.DropDownLines = 10
.DropDownWidth = 125
.TooltipText = "alte Jahreslisten öffnen"
.OnAction = "DateienLaden"
End With
myCB.Visible = True
Set myCB = Nothing
Set mycbb = Nothing
End Sub
Das ist einer meiner Codes, der jetzt das gleiche wie deiner macht
Gruss Rainer