Übereinanderliegende Shapes umbennen

Guten Tag Gemeinde :-))
Es sollen Shapes in einem Arbeitsblatt umbenannt werden.
Ein Shape (mit Text) enthält die 5 stellige PLZ ein weiteres
Shape ein Freeform, welches die Gebietsgrenzen dieser PLZ
darstellt.
Importbedingt haben nur die Shapes mit Text einen vernünftigen Namen.
Also z.B. 73516 die Shapes mit den Gebietsgrenzen allerdings haben noch
vogelwilde Namen also Freeform 3108 / Freeform 709 usw.
Ist es möglich diese Freeforms in einem Makro dahingehend anzusprechen,
dass ein Shape mit den Gebietsgrenzen, den Namen der PLZ bekommt, die
es darstellt ?
Immerhin liegen die Shapes mit dem Text der PLZ innerhalb der Shapes mit
den Gebietsgrenzen.
Any Idea ?
Vielen Dank & Schönes Wochenende
R.Schmitt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub tt() Dim shpPLZ As Shape, shpFree As Shape Dim shpFreeX1 As Single, shpFreeX2 As Single, shpFreeY1 As Single, shpFreeY2 As Single For Each shpFree In ActiveSheet.Shapes If shpFree.Type = msoFreeform Then With shpFree shpFreeX1 = .Top shpFreeY1 = .Left shpFreeX2 = .Top + .Width shpFreeY2 = .Left + .Left End With For Each shpPLZ In ActiveSheet.Shapes If shpPLZ.type = msoTextBox Then If shpPLZ.Top >= shpFreeX1 _ And shpPLZ.Top = shpFreeY1 _ And shpPLZ.Left

Hello Mr. Schmitt,
mit folgenden Makros kannst du die Shapes umbenennen.
Die Shapes werden zunächst unsichtbar gemacht und dann nach einander wieder eingeblendet und der Name kann in einer Inputbox angepasst werden.
Gruß
Franz


Sub Freeform_Shapes_Umbenennen()
Dim wks As Worksheet, Element As Shape, strName As String
Set wks = ActiveSheet
'Elemente unsicht barmachen
For Each Element In wks.Shapes
If Element.Type = msoFreeform Then
Element.Visible = False
End If
Next
'Elemente sichtbar machen und umbenennen
For Each Element In wks.Shapes
If Element.Type = msoFreeform Then
Element.Visible = True
strName = InputBox("Neuer Shape-Name?", "Shapes umbenennen", Element.Name)
If strName  "" Then Element.Name = strName
End If
Next
End Sub
Sub Alle_Shapes_Umbenennen()
Dim wks As Worksheet, Element As Shape, strName As String
Set wks = ActiveSheet
'Elemente unsicht barmachen
For Each Element In wks.Shapes
Element.Visible = False
Next
'Elemente sichtbar machen und umbenennen
For Each Element In wks.Shapes
Element.Visible = True
strName = InputBox("Neuer Shape-Name?", "Shapes umbenennen", Element.Name)
If strName  "" Then Element.Name = strName
Next
End Sub

Beliebteste Forumthreads (12 Monate)

Übereinanderliegende Shapes umbennen

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Übereinanderliegende Shapes umbennen

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread