Office: Schaltflächen sortieren

Hallo Karin,

die Codes von Dir und Michael habe ich getestet und beide sind richtig gut, wenn ich mit meinem Halbwissen das so sagen darf.
Die Datei mit dem Code von Dir habe als Anhang beigefügt.

See you,
Alex

 

Meine Berechnung richtet die Buttons zeilenweise aus, dann untereinander. Wenn Du 9 Buttons hast und 4 Spalten Breite einstellst, dann hast Du natürlich 2x 4 Buttons und 1 Button in der 3. Zeile.

Hast Du zeilenweise von links nach rechts geguckt? Die Sortierung läuft natürlich in gleicher Richtung wie die Platzierung. Zumindest bei mir sortiert das Ding eigentlich klaglos...

Wenn Du natürlich erst untereinander, z.B. 5 Zeilen lang, dann rechts herüber angeordnet haben willst, dann ist die Berechnung wieder etwas anders. Da Excel-Tabellen aber in der Regel eher schmal und lang sind, war ich von begrenzter Breite und beliebiger Höhe ausgegangen.

Gruß, Michael

 

Hallo Michael,

danke für die nette Antwort und Support. Bei Dir scheint es geklappt zu haben. Nur die alphabetische Sortierung meinte ich, die nicht funktioniert. Wenn du Button nachträglich umbenennst, dann fehlt die Sortierung1,2,3..A,B,C...
Das meinte ich damit, sonst Top wie immer.
:!: :!: :!:

Alex

 

Ähm... Dir ist schon klar, daß die Sortierung auch durch irgendwas angeschubst werden muß, ja? Deswegen sitzt da ja dieser "Sortieren" Button auf dem Blatt...

Wenn Du "Schaltfläche 7" z.B. mal in "Klaus" umbenennst (genau genommen: die Beschriftung änderst, denn der Name bleibt der gleiche...), dann bleibt der Button trotzdem genau an der Stelle stehen. Nach Klick auf "Sortieren" allerdings...

Ansonsten müßtest Du vielleicht mal genauer beschreiben, was Du mit "funktioniert nicht" eigentlich genau meinst...

Gruß, Michael

 

Hallo Michael,

sorry, hatte gestern einen kleinen Burnout.
Mir sind deine Ausführung klar. Ich startete die Makros entweder im VBA-Editor oder durch diesen Button "Sortieren".
Dennoch wurden die Buttons entweder gestaucht oder es wurden noch weitere hinzugefügt und irgendwo auf dem Tabellenblatt abgelegt.

Ich muss auch sagen, dass ich mit mehreren Excel-Version arbeite. Vielleicht liegt es auch daran (Versionen 2002 und 2010).

In einer anderen Tabelle hat es allerdings funktioniert.
Wie ich gemerkt habe, kann ich dieses Sortieren nur in einer Tabelle ausführen. Somit fehlt die Ausführung in mehreren Tabellenblättern wohl flach oder?

Liebe Grüße

Alex

 

Keine Ahnung, was da passiert. Der Code setzt eigentlich nur die Eigenschaft "linke obere Ecke" der Buttons. Da werden keine neuen erzeugt und auch Höhe/Breite nicht verändert.

Du hattest bislang auch nur von einem Tabellenblatt gesprochen.

Wenn Du 30+ Buttons hast, die auf jeweils ein anderes Blatt verweisen und dort ebenfalls wieder 30+ Buttons hast, also schonmal mindestens 900 in der Mappe insgesamt, dann würde ich mir an Deiner Stelle aber mal grundlegend das Konzept überdenken.

Eventuell wäre eine ComboBox (so'ne Ausklappliste, auch Drop-Down genannt) sinnvoller. Oder vielleicht auch eine Userform als zentrale Navigation, statt die Buttons auf allen Blättern zu wiederholen.

Nichtsdestotrotz, auch auf jedem beliebigen Blatt kann man diese Sortierung einrichten. Dazu sind gar nicht mal sooo viele Änderungen notwendig.

Die eigentliche Sortier-Routine packt man dann in ein Extra-Modul, Das Button-Ereignis ruft dann diese globale Routine auf. Dabei werden dann Parameter übergeben. Als wichtigster wohl zuerst mal das Blatt, auf dem sortiert werden soll. Weiters könnte man die linke obere Position, den Spalten- und Zeilen-Abstand und die Breite der Button-Matrix übergeben, wenn sie denn auf den einzelnen Blättern vielleicht unterschiedlich sein sollten. Durch "optional"-Deklaration der Parameter kann man auch für Default-Werte sorgen.

Den folgenden Source in einem Code-Modul kannst Du für die ActiveX-Buttons verwenden. Für die Formular-Buttons sind leichte Änderungen notwendig, aber die hatte ich ja schon in den 2 Varianten gepostet.

Code:

Option Explicit

Public Sub Sortieren1( _
    Optional sht$ = "", _
    Optional top_y& = 1, _
    Optional top_x& = 1, _
    Optional gap_y& = 1, _
    Optional gap_x& = 1, _
    Optional len_x& = 1, _
    Optional cel As Boolean = False)

    'sht:   Name des Arbeitsblatts, auf dem die Buttons sortiert werden sollen.
    '       Default = leer, es wird das aktuelle Blatt benutzt.
    'top_y: Erste Zeile (Zelle im Blatt) der Matrix
    '       Default = 1
    'top_x: Erste Spalte der Matrix
    '       Default = 1, Spalte A
    'gap_y: Abstand (in Zellen) zwischen den Buttons
    '       Default = 1, fortlaufend ohne Zwischenraum
    'len_x: max. Breite der Button-Matrix
    '       Default = 1, nicht nebeneinander, alle Button nur untereinander
    'cel:   ja/nein, ob die Buttons an die Zellgröße angepaßt werden sollen
    '       Default = false, Buttons werden nicht auf die Zellengröße angepaßt

    Dim obj As Object
    Dim btn(64, 2) As String
    Dim n As Long
    Dim m As Long
    Dim nn As Long
    Dim s1 As String
    Dim s2 As String
    Dim yz As Long
    Dim xz As Long
    Dim yp As Long
    Dim xp As Long
    Dim ym As Long
    Dim xm As Long
    Dim ws As Worksheet

    If (sht = "") Then
        Set ws = ActiveSheet
      Else
        Set ws = Worksheets(sht)
    End If

    'Einlesen aller ActiveX-Buttons, deren Namen nicht "btn_Sortieren1" sind
    n = 0
    For Each obj In ws.OLEObjects
        If (obj.ProgId = "Forms.CommandButton.1") And (obj.Name <> "btn_Sortieren1") Then

            n = n + 1
            btn(n, 1) = obj.Name
            btn(n, 2) = obj.Object.Caption

        End If
    Next obj
    nn = n

    'Sortieren der Objekte-Liste
    'simpelster Bubble-Sort, allerdings mit kleinen Optimierungen
    For n = 1 To nn - 1
        For m = n + 1 To nn

            If (btn(n, 2) > btn(m, 2)) Then
                s1 = btn(n, 1)
                s2 = btn(n, 2)
                btn(n, 1) = btn(m, 1)
                btn(n, 2) = btn(m, 2)
                btn(m, 1) = s1
                btn(m, 2) = s2
            End If

        Next m
    Next n

    'Neu-Platzierung der Objekte
    For n = 1 To nn

        'Position in der Matrix bestimmen
        ym = Int((n - 1) / len_x)
        xm = (n - 1) Mod len_x

        'Zelle des Arbeitsblatts bestimmen
        yz = ym * gap_y + top_y
        xz = xm * gap_x + top_x

        'Position des Buttons auf dem Blatt bestimmen
        yp = ws.Cells(yz, xz).Top
        xp = ws.Cells(yz, xz).Left

        'Button platzieren
        Set obj = ws.OLEObjects(btn(n, 1))
        obj.Top = yp
        obj.Left = xp

        'ggf. Button-Größe an Zell-Größe anpassen
        If (cel) Then
            obj.Width = Cells(yz, xz).Width
            obj.Height = Cells(yz, xz).Height
        End If

    Next n

End Sub

Der Aufruf dieser Sortieren- bzw. Anordnen-Routine aus dem Modul des jeweiligen Blatts heraus sieht dann z.B. so aus:

Code:

Private Sub btn_Sortieren1_Click()

    Sortieren1

End Sub

oder auch:

Code:

    Sortieren1 ActiveSheet.Name, 5, 2, 2, 2, 4, True

oder

Code:

    Sortieren1 top_y:=5, cel:=True

oder wie auch immer...

Gruß, Michael

 

Hi Alex,

ich habe deine hochgeladene Arbeitsmappe getestet: einige Schaltflächenbezeichnungen gibt es doppelt - "Schaltfläche 1" gibt es 13 mal und "dSchaltfläche 9" gibt es 2 mal. Dann musst du dich auch nicht wundern, wenn die Schalter nicht korrekt sortiert werden, denn bei den mehrfach vorkommenden wird immer der selbe Schalter angeordnet und nicht die anderen mit der selben Beschriftung. Lösche alle mehrfach vorkommenden Schalter oder benenne sie um.

Da es auch einen Schalter "Sortieren" gibt, musst du diesen Teil des Code ändern:

Code:

   For Each cmdSchalter In ActiveSheet.Buttons
      If cmdSchalter.Caption <> "Sortieren" Then
         ReDim Preserve arrSchalter(0 To UBound(arrSchalter()) + 1)
         arrSchalter(UBound(arrSchalter())) = cmdSchalter.Caption
      End If
   Next cmdSchalter

damit dieser Schalter nicht berücksichtigt wird.

Außerdem kann man den Code noch etwas beschleunigen durch Änderung dieses Codeteils:

Code:

      For Each cmdSchalter In ActiveSheet.Buttons
         If cmdSchalter.Caption = arrSchalter(intSchalter) Then
            cmdSchalter.Top = Rows(lngZeile).Top
            cmdSchalter.Left = Columns(intSpalte).Left
            intSpalte = intSpalte + 1
            Exit For
         End If
      Next cmdSchalter

Bis später,
Karin

 

Was würde ich ohne euch machen, liebe Freunde...

Ich teste es zeitnah

Liebe Grüße

Alex

PS: danke für die Geduld mit mir

 

Hallo Karin,

ich habe jetzt noch einige Veränderungen, die du mir empfohlen hast integriert. Somit ergibt sich ein folgendes Bild:

Code:

Sub SchalterSortieren()
   Dim cmdSchalter As Button
   Dim intSchalter As Integer
   Dim lngZeile As Long
   Dim intZaehler As Integer
   Dim intSpalte As Integer
   ReDim arrSchalter(0)
   For Each cmdSchalter In ActiveSheet.Buttons
      ReDim Preserve arrSchalter(0 To UBound(arrSchalter()) + 1)
      arrSchalter(UBound(arrSchalter())) = cmdSchalter.Caption
   Next cmdSchalter
   QuickSort arrSchalter(), 1, UBound(arrSchalter())
   lngZeile = 2
   intSpalte = 1
   For intSchalter = 1 To UBound(arrSchalter())
      For Each cmdSchalter In ActiveSheet.Buttons
      If cmdSchalter.Caption <> "Sortieren" Then
         ReDim Preserve arrSchalter(0 To UBound(arrSchalter()) + 1)
         arrSchalter(UBound(arrSchalter())) = cmdSchalter.Caption
      End If
   Next cmdSchalter
      For Each cmdSchalter In ActiveSheet.Buttons
         If cmdSchalter.Caption = arrSchalter(intSchalter) Then
            cmdSchalter.Top = Rows(lngZeile).Top
            cmdSchalter.Left = Columns(intSpalte).Left
            intSpalte = intSpalte + 1
            Exit For
         End If
      Next cmdSchalter
      ' wenn Spalte 7 erreicht dann wieder mit Spalte 1 beginnen
      If intSpalte Mod 7 = 1 Then
         intSpalte = 1
         lngZeile = lngZeile + 3
      End If
   Next intSchalter
End Sub

Sub QuickSort(ByRef VA_Array, Optional V_Low1, Optional V_High1)
' [url]http://www.herber.de/forum/archiv/108to112/t109556.htm[/url]
    On Error Resume Next
    Dim V_Low2 As Long, V_High2 As Long
    Dim V_Val1, V_Val2 As Variant
    If IsMissing(V_Low1) Then
        V_Low1 = LBound(VA_Array, 1)
    End If
    If IsMissing(V_High1) Then
        V_High1 = UBound(VA_Array, 1)
    End If
    V_Low2 = V_Low1
    V_High2 = V_High1
    V_Val1 = VA_Array((V_Low1 + V_High1) / 2)
    While (V_Low2 <= V_High2)
        While (VA_Array(V_Low2) < V_Val1 And _
            V_Low2 <V_High1> V_Val1 And _
            V_High2 > V_Low1)
            V_High2 = V_High2 - 1
        Wend
        If (V_Low2 <V_High2> V_Low1) Then Call _
        QuickSort(VA_Array, V_Low1, V_High2)
    If (V_Low2 < V_High1) Then Call _
        QuickSort(VA_Array, V_Low2, V_High1)
End Sub

Leider bleibt "Sortieren"-Button nicht wo er vor der Sortierung war, sondern wird ebenfalls mitsortiert.

Ansonsten funktioniert dieser Code in der Muster-Datei.
Gleich teste ich die Empfehlungen von Michael.

Vielen Dank für alles!

Alex

 

Hi Alex,

mein Code mit den entsprechenden Änderungen sieht anders aus:

Code:

Sub SchalterSortieren()
   Dim cmdSchalter As Button
   Dim intSchalter As Integer
   Dim lngZeile As Long
   Dim intZaehler As Integer
   Dim intSpalte As Integer
   ReDim arrSchalter(0)
   For Each cmdSchalter In ActiveSheet.Buttons
      If cmdSchalter.Caption <> "Sortieren" Then
         ReDim Preserve arrSchalter(0 To UBound(arrSchalter()) + 1)
         arrSchalter(UBound(arrSchalter())) = cmdSchalter.Caption
      End If
   Next cmdSchalter
   QuickSort arrSchalter(), 1, UBound(arrSchalter())
   lngZeile = 2
   intSpalte = 1
   For intSchalter = 1 To UBound(arrSchalter())
      For Each cmdSchalter In ActiveSheet.Buttons
         If cmdSchalter.Caption = arrSchalter(intSchalter) Then
            cmdSchalter.Top = Rows(lngZeile).Top
            cmdSchalter.Left = Columns(intSpalte).Left
            intSpalte = intSpalte + 1
            Exit For
         End If
      Next cmdSchalter
      ' wenn Spalte 7 erreicht dann wieder mit Spalte 1 beginnen
      If intSpalte Mod 7 = 1 Then
         intSpalte = 1
         lngZeile = lngZeile + 3
      End If
   Next intSchalter
End Sub

Bis später,
Karin

 

Gelobt sei Bill Gates...

Es hat tatsächlich funktioniert.
Ich schulde aber noch ein Statement für Michaels Lösung.
Ich bleibe dran, mindestens das bin ich euch noch schuldig.

Mein Dank ist euch sicher!

Alex