VBA Code - Rechteck wird nicht gelöscht

Forumthread: VBA Code - Rechteck wird nicht gelöscht
7 Beiträge zu diesem Forumthread
Anzeige
Threads zu ähnlichen Themen

Forumthread: VBA Code - Rechteck wird nicht gelöscht

22.04.2025 11:11:17

Kurt

Guten Morgen,

ich habe untenstehenden VBA Code der bis auf eine Kleinigkeit nicht funktioniert und würde daher um Hilfe bitten.

Problem: Das Rechteck wird nach dem kopieren nicht gelöscht, wie muss der Code aussehen, damit dieses auch tatsächlich gelöscht wird?

Hier mein Code:

Sub Makro1()
'
' Makro1 Makro
'

'
Sheets("Leer").Copy Before:=Sheets("Leer")
ActiveSheet.Unprotect Password:="qwualpsf"
With Range("AB7:AF9,CT5:DC7,CI26:CR27,DE26:DN27,AJ30:BU42,A21:N27,R22:AI22,A34:D34,E34:S34,T34:AI34,AY12:BF13,R24:AI24,R26:AI26")
.Locked = False
.FormulaHidden = False
End With
ActiveSheet.Name = Format(fncNextNumber, "000")
With Range("CT5")
.Select
Application.EnableEvents = False
.Value = Val(ActiveSheet.Name)
Application.EnableEvents = True
End With
ActiveSheet.Shapes.Range(Array("Rectangle 65")).Select
Selection.Delete
Range("CT5").Select
ActiveSheet.Protect Password:="qwualpsf"
End Sub

Ich Danke für jegliche Hilfe, liebe Grüße wünscht
Kurt

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA Code - Rechteck wird nicht gelöscht

22.04.2025 11:25:02

UweD
AW: VBA Code - Rechteck wird nicht gelöscht

22.04.2025 12:38:37

Kurt
AW: VBA Code - Rechteck wird nicht gelöscht

22.04.2025 11:56:25

hary
VBA Code - Gelöst

22.04.2025 13:35:00

Kurt
AW: VBA Code - Rechteck wird nicht gelöscht

22.04.2025 13:56:12

{Boris}
AW: VBA Code - Gelöst

22.04.2025 13:51:25

velo
AW: VBA Code - Rechteck wird nicht gelöscht

22.04.2025 12:39:47

Kurt

AW: VBA Code - Rechteck wird nicht gelöscht

22.04.2025 11:25:02

UweD

Hallo

Wenn das Rechteck mit dem Namen nicht vorhanden ist, kommt eine Fehlermeldung.

Achte auf genaue Schreibweise

Sonst so...

...

On Error Resume Next

ActiveSheet.Shapes("Rectangle 65").Delete

On Error GoTo 0

...

LG UweD

AW: VBA Code - Rechteck wird nicht gelöscht

22.04.2025 12:38:37

Kurt

Hallo Uwe,

hat leider nicht geklappt und habe es so gelöst, das ich das Rechteck einfach weglasse.

Danke und LG,
Kurt

AW: VBA Code - Rechteck wird nicht gelöscht

22.04.2025 11:56:25

hary

Moin
Durch kopieren wird aus Rectangle 65 Rectangle 66
ersetz mal:

ActiveSheet.Shapes.Range(Array("Rectangle 65")).Select

Selection.Delete

durch
Es werden aber alle Rechtecke geloescht. Gibt davon mehrere?

Dim Shp As Shape

' Durchlaufe alle Shapes im Arbeitsblatt

For Each Shp In ActiveSheet.Shapes

 If Shp.Name Like "Rectangle*" Then

    Shp.Delete

 End If

Next Shp

Hilfts?
gruss hary

VBA Code - Gelöst

22.04.2025 13:35:00

Kurt

Hallo nochmals Beiden Helfern,

bin draufgekommen, es war Tatsächlich die Bezeichnung 65 falsch, nun ist es die 37.

Grund wird wohl der Wechsel auf das neue Office gewesen sein.

Danke nochmals, LG
Kurt

AW: VBA Code - Rechteck wird nicht gelöscht

22.04.2025 13:56:12

{Boris}

Hi,

als Nachtrag: Wenn Du den Namen des Shapes nicht kennst, dafür aber dessen TopLeftCell, dann kannst Du das gewünschte Shape (Rechteck) per Schleife ermitteln.

Im Beispiel wird das Shape mit der TopLeftCell-Adresse "K3" gesucht und testweise dessen Name ausgegeben:

Option Explicit



Sub Bestimmtes_Rechteck()

Const strAddress As String = "K3"

Dim Sh As Shape

For Each Sh In ActiveSheet.Shapes

    If Sh.TopLeftCell.Address(0, 0) = strAddress Then

        MsgBox Sh.Name & " wurde gefunden.", vbOKOnly, "TopLeftCell: " & strAddress

    End If

Next Sh

End Sub

VG, Boris

AW: VBA Code - Gelöst

22.04.2025 13:51:25

velo

Hallo Kurt,

ich würde dir empfehlen, den Namen zu ändern.
Ich habe gerade selbst ein wenig getestet und in Ausnahmefällen ändert sich beim kopieren der Zähler (also 65 auf 66 bzw. 37 auf 38).

Nenne das Rechteck das du löschen willst z.B. "MeinRechteck 1" und dann kannst du mit harys Lösung auch zuverlässig das Rechteck löschen.

Code von hary angepasst auf o.g. Beispiel:

Dim Shp As Shape

' Durchlaufe alle Shapes im Arbeitsblatt

For Each Shp In ActiveSheet.Shapes

 If Shp.Name Like "MeinRechteck*" Then

    Shp.Delete

 End If

Next Shp

Es funktioniert auch ohne, die Frage ist aber wie lange.

VG
velo

AW: VBA Code - Rechteck wird nicht gelöscht

22.04.2025 12:39:47

Kurt

Hallo hary,

hat leider auch nicht geklappt und habe es so gelöst, das ich das Rechteck einfach weglasse.
Und um Deine Frage zu beantworten, ja es gibt noch sehr viele Rechtecke.

Danke und LG,
Kurt