Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.10.2025 10:28:49
16.10.2025 17:40:39
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Markierten Shapes weitere hinzufügen (VBA)

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
Anzeige

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
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
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige