Shapes sortieren

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Shapes sortieren
von: Patrick
Geschrieben am: 01.09.2015 22:24:03

Hallo alle Zusammen, ich hab ein Problem mit Shapes.
In Tabelle 1 befinden sich mehrere Ellipsen als Shapes(könnten gut und gern 300 werden).
Alle haben die selbe Farbe,Form und Größe
Ich suche nun nach einer Möglichkeit diese von Oben nach unten, sowie links nach rechts anzusprechen.
Über eine zählschleife mit

Sheets("Tabelle1").Shapes.Range(i)

geht es leider nicht da die Shapes willkührlich angelegt worden, d.h. nicht dem gefordeten muster entsprechen.
habt ihr hierfür eine Idee?
Danke schon mal vorab

Bild

Betrifft: AW: Shapes sortieren
von: Alfons
Geschrieben am: 02.09.2015 17:57:03
Hallo,
versuch's mal so:

Private Sub AlleEllipsen()
Dim wks As Worksheet, wksDummy As Worksheet
Dim sha As Shape
Dim lngZe As Long
Dim varList As Variant
'--------------------------------------------------
'alle Ovale von links nach rechts durchlaufen
'--------------------------------------------------
  Set wks = ActiveSheet
  Set wksDummy = Worksheets.Add
  
  For Each sha In wks.Shapes
    If sha.AutoShapeType = msoShapeOval Then
      lngZe = lngZe + 1
      wksDummy.Cells(lngZe, 1) = sha.Name
      wksDummy.Cells(lngZe, 2) = sha.Top
      wksDummy.Cells(lngZe, 3) = sha.Left
            
      'Debug.Print sha.Name & " -> " & sha.Top & " --- " & sha.Left
    End If
  Next
  
  'von links nach rechts: C1
  'von oben nach unten:   B1
  wksDummy.Columns("A:C").Sort Key1:=Range("C1"), _
                               Order1:=xlAscending ', _
                               Header:=xlGuess, _
                               OrderCustom:=1, _
                               MatchCase:=False, _
                               Orientation:=xlTopToBottom, _
                               DataOption1:=xlSortNormal
    
  With wksDummy
    varList = .Range(.Cells(1, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 3))
  End With
  
  'MsgBox UBound(varList) & " Einträge"
  
  Application.DisplayAlerts = False
  wksDummy.Delete
  Application.DisplayAlerts = True
  
  For lngZe = 1 To UBound(varList)
    'MsgBox varList(lngZe, 1) 'ShapeName
    wks.Shapes(varList(lngZe, 1)).Select
    Stop
  Next lngZe
  
  Erase varList
  Set wksDummy = Nothing
  Set wks = Nothing
End Sub
Gruß
Alfons
http://vba1.de

Bild

Betrifft: AW: Shapes sortieren
von: Matthias
Geschrieben am: 02.09.2015 19:25:08
Hallo Patrick, hallo Alfons,
ich habs leider nicht ganz so hübsch gestaltet wie Alfons, jedoch die gleiche Grundstrategie gehabt. Deine Lösung ist da durchaus effizienter.
Was mir an deiner (Alfons) Version nicht gefällt, du sortierst zwar von links nach rechts, lässt dabei aber die Höhe völlig außer Acht. Kommt es vor dass Shapes linksbündig am gleichen Zellenrand stehen, wird leider bunt durcheinander selektiert, in der Reihenfolge wie sie eben erstellt wurden. Bei meiner Version ist das in der Berechnung des Ranges gelöst, bei dir müsste man die Sortierung der Horizontalen vor der Sortierung der Vertikalen ergänzen bzw. für "Von oben nach unten" anderes herum.

Sub Shapes_anwaehlen()
Dim ws As Worksheet, wsTmp As Worksheet
Dim x As Long, Counter As Long
Dim sh As Shape
Dim rZelle As Range
Set ws = Tabelle1
' temporäres TB anlegen
Set wsTmp = Worksheets.Add
' Positionen der Shapes übertragen und Formeln eintragen
With wsTmp
    For Each sh In ws.Shapes
        Counter = Counter + 1
        .Cells(Counter, 1).Value = sh.Left
        .Cells(Counter, 2).Value = sh.Top
        .Cells(Counter, 3).FormulaR1C1 = "=Rank(RC1,C1)+Rank(RC2,C2)%%%+Row()%%%%%%"
        .Cells(Counter, 4).FormulaR1C1 = "=Rank(RC3, C3)"
    Next sh
    
    ws.Activate
    
    ' Suchen des Ranges in Spalte D und entsprechendes Shape auswählen
    For x = 1 To Counter
        Set rZelle = .Range("D:D").Find(What:=x, LookIn:=xlValues, lookat:=xlWhole)
        ws.Shapes(rZelle.Row).Select
        ' ...
        ' deine gewünschten Aktionen mit dem Shape
        ' ...
    Next x
    Application.DisplayAlerts = False
    .Delete
    Application.DisplayAlerts = True
End With
End Sub
lg Matthias

Bild

Betrifft: AW: Shapes sortieren
von: Patrick
Geschrieben am: 02.09.2015 20:50:21
Vielen Dank!
Das ist genau das was ich gesucht habe.

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Shapes sortieren"