Thema: Menüpunkte sortieren

ClassModule: DieseArbeitsmappe

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   Call MenuLoeschen
End Sub

StandardModule: basMain

Sub NeuesMenu()
   Dim oBar As CommandBar
   Dim oPopUp As CommandBarPopup
   Dim oBtn As CommandBarButton
   Set oBar = Application.CommandBars("Worksheet Menu Bar")
   Set oPopUp = oBar.Controls.Add(msoControlPopup, temporary:=True)
   Call MenuLoeschen
   oPopUp.Caption = "MeinMenu"
   Set oBtn = oPopUp.Controls.Add
   oBtn.Caption = "B-Befehl"
   Set oBtn = oPopUp.Controls.Add
   oBtn.Caption = "A-Befehl"
   Set oBtn = oPopUp.Controls.Add
   oBtn.Caption = "C-Befehl"
End Sub

Sub MenuSortieren()
   Dim arr() As String
   Dim oBar As CommandBar
   Dim oPopUp As CommandBarPopup
   Dim oBtn As CommandBarButton
   Dim iCountA As Integer, iCountB As Integer
   Dim sTxt As String
   Set oBar = Application.CommandBars("Worksheet Menu Bar")
   Set oPopUp = oBar.Controls("MeinMenu")
   For Each oBtn In oPopUp.Controls
      iCountA = iCountA + 1
      ReDim Preserve arr(iCountA)
      arr(iCountA) = oBtn.Caption
   Next oBtn
   For iCountA = 1 To UBound(arr)
      For iCountB = iCountA + 1 To UBound(arr)
         If arr(iCountA) > arr(iCountB) Then
            sTxt = arr(iCountA)
            arr(iCountA) = arr(iCountB)
            arr(iCountB) = sTxt
         End If
      Next iCountB
   Next iCountA
   For Each oBtn In oPopUp.Controls
       oBtn.Delete
   Next oBtn
   For iCountA = 1 To UBound(arr)
      Set oBtn = oPopUp.Controls.Add
      oBtn.Caption = arr(iCountA)
    Next iCountA
End Sub

Sub MenuLoeschen()
   On Error Resume Next
   Application.CommandBars( _
      "Worksheet Menu Bar").Controls("MeinMenu").Delete
   On Error GoTo 0
End Sub

Beiträge aus dem Excel-Forum zu den Themen Menue und Button