Hallo allerseits
Ich habe ein VBA-Makro für Excel vor mir. In Excel 2003 wurde das Menü dafür direkt als unverankerte Symbolleiste dargestellt. In Excel 2010 wir das Menü vom Makro aber standardmässig unter dem Layer "Add-Ins" geladen. Wie kann ich in Excel 2010 eine unverankerte Symbolleiste für ein VBA-Makro erstellen?
So als anmerkung: Ich kenne das Makro nicht, habe es nämlich nicht geschrieben. Ausserdem kenne ich mich sehr schlecht mit Visual Basic aus.
Hier noch der Code:
Sub MenuErstellen()
Dim Menu As CommandBar
Dim Schlüssel, Sortieren, Suchen As CommandBarControl
Dim Schlüssel1, Schlüssel2, Schlüssel3 As CommandBarControl 'Einträge unter Schlüssel
Dim Sortieren1, Sortieren2 As CommandBarControl 'Einträge unter Sortieren
Dim Suchen1 As CommandBarControl 'Einträge unter Suchen
Dim MenuName
MenuName = "Schlüsselverwaltung"
On Error GoTo einblenden
Set Menu = Application.CommandBars.Add(Name:=MenuName)
Application.CommandBars("Schlüsselverwaltung").Visible = True
'Einträge unter Schlüssel
Set Schlüssel = Menu.Controls.Add(Type:=msoControlPopup)
Schlüssel.Caption = "Schlüssel"
Set Schlüssel1 = Schlüssel.Controls.Add(Type:=msoControlButton)
Schlüssel1.Caption = "Abgabe"
Schlüssel1.OnAction = "SAbgabeZeigen"
Set Schlüssel2 = Schlüssel.Controls.Add(Type:=msoControlButton)
Schlüssel2.Caption = "Rückname"
Schlüssel2.OnAction = "SRückgabeZeigen"
Set Schlüssel3 = Schlüssel.Controls.Add(Type:=msoControlButton)
Schlüssel3.Caption = "vorhandene Schlüssel"
Schlüssel3.OnAction = "zuVorhSchlüssel"
'Einträge unter Sortieren
Set Sortieren = Menu.Controls.Add(Type:=msoControlPopup)
Sortieren.Caption = "sortieren"
Set Sortieren1 = Sortieren.Controls.Add(Type:=msoControlButton)
Sortieren1.Caption = "nach Schlüssel"
Sortieren1.OnAction = "SortSchlüssel"
Set Sortieren2 = Sortieren.Controls.Add(Type:=msoControlButton)
Sortieren2.Caption = "nach Namen"
Sortieren2.OnAction = "SortNamen"
Set Suchen = Menu.Controls.Add(Type:=msoControlPopup)
Suchen.Caption = "Suchen"
Set Suchen1 = Suchen.Controls.Add(Type:=msoControlButton)
Suchen1.Caption = "Namen"
Suchen1.OnAction = "frmNamenSucheEinblenden"
einblenden:
Application.CommandBars("Schlüsselverwaltung").Visible = True
End Sub
Sub SAbgabeZeigen()
frmSAbgabe.Show
End Sub
Sub SRückgabeZeigen()
frmSRückgabe.Show
End Sub
Sub SortNamen()
ActiveSheet.Unprotect
Range("A6").Select
Selection.sort Key1:=Range("A6"), Order1:=xlAscending, Key2:=Range("B6") _
, Order2:=xlAscending, Key3:=Range("C6"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Sub SortSchlüssel()
ActiveSheet.Unprotect
Range("A6").Select
If ActiveSheet.Name = "Schlüssel" Then
Selection.sort Key1:=Range("C6"), Order1:=xlAscending, Key2:=Range("H6") _
, Order2:=xlAscending, Key3:=Range("A6"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A6").Select
Exit Sub
End If
If ActiveSheet.Name = "Schlüsselrückgabe" Then
Selection.sort Key1:=Range("C6"), Order1:=xlAscending, Key2:=Range("I6") _
, Order2:=xlAscending, Key3:=Range("A6"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A6").Select
Else
MsgBox "In dieser Tabelle ist diese Funktion nicht verfügbar.", , _
"Funktion nicht verfügbar"
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Sub zuVorhSchlüssel()
Sheets("Schlüssel").Select
SortNamen
Range("C6").Select
Selection.End(xlDown).Select
End Sub
Sub frmNamenSucheEinblenden()
frmNamenSuchen.Show
End Sub
|