Shapes sortieren

Forumthread: Shapes sortieren

Shapes sortieren

01.09.2015 22:24:03

Patrick

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

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Shapes sortieren

02.09.2015 17:57:03

Alfons
AW: Shapes sortieren

02.09.2015 19:25:08

Matthias
AW: Shapes sortieren

02.09.2015 20:50:21

Patrick

AW: Shapes sortieren

02.09.2015 17:57:03

Alfons

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

AW: Shapes sortieren

02.09.2015 19:25:08

Matthias

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

AW: Shapes sortieren

02.09.2015 20:50:21

Patrick

Vielen Dank!
Das ist genau das was ich gesucht habe.

Beliebteste Forumthreads (12 Monate)

Forumthread: Shapes sortieren

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread