Markierten Shapes weitere hinzufügen (VBA)

Forumthread: Markierten Shapes weitere hinzufügen (VBA)

28.07.2006 14:21:20

Jorainbo

hallo zusammen,
ich möchte gerne einen Auswahlrahmen für Zeichnungselemente erstellen und dann alle darin befindlichen Elemente markiert haben (um sie anschließend zu gruppieren).
Der Rahmen existiert schonmal und heisst auch so. Weiter komme ich aber nicht:
ActiveSheet.Shapes("Rahmen").Select
With Selection
links = .left
oben = .top
End With
For Each i In ActiveSheet.Shapes
If i.left &gt links And i.top &gt oben Then
' dann füge dies der Auswahl hinzu...aber wie?
End If
Next i
Vielen Dank im Voraus für jeden Tipp!
Grüße
Thomas

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Markierten Shapes weitere hinzufügen (VBA)

28.07.2006 15:37:51

fcs
DANKE!

31.07.2006 09:43:41

Jorainbo

AW: Markierten Shapes weitere hinzufügen (VBA)

28.07.2006 15:37:51

fcs

Hallo Thomas,
hier zwei Varianten, wie man die Shapes gruppieren kann. Dabei werden die Namen der Shapes, die die Bedingung erfüllen, zunächst in einem Feld gesammelt und anschließend erfolgt die Gruppierung.


Sub GruppierenmitRahmen()
'Shapes innerhalb des Rahmens werden gruppiert, Rahmen wird Teil der Gruppierung
Dim I As Shape, Figuren()
ActiveSheet.Shapes("Rahmen").Select
With Selection
links = .Left
oben = .Top
unten = oben + .Height
rechts = links + .Width
ReDim Figuren(0 To 0)
Figuren(0) = Selection.Name
End With
J = 1
For Each I In ActiveSheet.Shapes
If I.Left > links And I.Top > oben And I.Left + I.Width < rechts And I.Top + I.Height < unten Then
ReDim Preserve Figuren(0 To J)
Figuren(J) = I.Name
J = J + 1
End If
Next I
ActiveSheet.Shapes.Range(Figuren).Group
Erase Figuren
End Sub
Sub GruppierenohneRahmen()
'Shapes innerhalb des Rahmens werden gruppiert
Dim I As Shape, Figuren(), J As Integer
ActiveSheet.Shapes("Rahmen").Select
With Selection
links = .Left
oben = .Top
unten = oben + .Height
rechts = links + .Width
End With
J = 0
For Each I In ActiveSheet.Shapes
If I.Left > links And I.Top > oben And I.Left + I.Width < rechts And I.Top + I.Height < unten Then
ReDim Preserve Figuren(0 To J)
Figuren(J) = I.Name
J = J + 1
End If
Next I
ActiveSheet.Shapes.Range(Figuren).Group
Erase Figuren
End Sub

gruss Franz

DANKE!

31.07.2006 09:43:41

Jorainbo

dankeschön! Funktioniert super!
Natürlich ist Höhe und Breite des "Rahmens" auch noch relevant. Vielmehr aber kannte ich bisher die ReDim-Anweisung nicht ... wieder was gelernt :-)
Beste Grüße
Thomas

Beliebteste Forumthreads (12 Monate)

Markierten Shapes weitere hinzufügen (VBA)

Forumthread: Markierten Shapes weitere hinzufügen (VBA)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread