Software für Sie.

Nostalgie - mehr ist das wohl heute nicht mehr. Oder nutzt noch jemand die alten Menüs in Excel?

Sub MenueErstellen() Dim objAktiveMenueLeiste As Object Dim objMeinMenue As Object, objBefehl As Object, objMB As Object 'objMB, objMeinMenue, Befehl und objAktiveMenüLeiste sind Variablen On Error Resume Next 'Eigene Menüleiste löschen, falls Makro nochmal aufgerufen wird: Application.CommandBars("MeinMenü").Delete 'Falls keine eigene Menüleiste erstellt wurde, sondern nur ein Menü: CommandBars.ActiveMenuBar.Controls("Mein Menü").Delete 'Menüleiste hinzufügen und einblenden 'Soll die aktive Menüleiste ersetzt werden, Hochkommas entfernen: 'Set objMB = CommandBars.Add(Name:="MeinMenü", MenuBar:=True) 'CommandBars("MeinMenü").Visible = True Set objAktiveMenueLeiste = CommandBars.ActiveMenuBar 'Menü erstellen Set objMeinMenue = objAktiveMenueLeiste.Controls.Add(Type:=msoControlPopup, Temporary:=True) objMeinMenue.Caption = "&Mein Menü" 'Anstelle Makroname den Makro einsetzen 'Erster Befehl im Menü Set objBefehl = objMeinMenue.Controls.Add(Type:=msoControlButton, ID:=1) With objBefehl .Caption = "&1. Befehl" .OnAction = "Makroname" End With 'Zweiter Befehl im Menü Set objBefehl = objMeinMenue.Controls.Add(Type:=msoControlButton, ID:=1) With objBefehl .Caption = "&2. Befehl" .OnAction = "Makroname" End With End Sub 'Um die Original-Menüleiste wieder einzublenden kann man 'folgendes Makro verwenden: Sub EigeneMenueLeisteLoeschen() On Error Resume Next 'Löscht die selbsterstellte Menüleiste: Application.CommandBars("MeinMenü").Delete 'Löscht nur das Menü CommandBars.ActiveMenuBar.Controls("Mein Menü").Delete End Sub

Eine Lösung, die noch aus den alten Diskettenlaufwerk stammt - aus Nostalgiegründen ist sie noch hier:

Sub LaufwerkAuswahl() Dim intI As Integer Dim strLWs As String, strLW As String, strStart As String strStart = Left(CurDir, 1) On Error Resume Next For intI = 97 To 122 'Laufwerke für den Inputbox-Text zusammenstellen Err.Clear ChDrive Chr(intI) If Err = 0 Then strLWs = strLWs & Chr(intI) & "," Next intI strLWs = Left(strLWs, Len(strLWs) - 1) strLW = InputBox("Bitte Laufwerk wählen (" & strLWs & "):", Right(strLW, 1)) If strLW = "" Then ChDrive strStart Else ChDrive strLW End If MsgBox CurDir End Sub