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