Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Menüpunkte sortieren

Gruppe

Button

Problem

Wie kann ich in XL8 einzelne Menüpunkte eines benutzerdefinierten Menüs alphabetisch anordnen?

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

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