Namensgleichheit kopierter Shapes

Forumthread: Namensgleichheit kopierter Shapes

29.10.2024 12:47:10

Selfmade

Hallo liebes Forum,

ich bin Hobbyprogramierer und habe für meine Arbeitsstelle eine Excelanwendung erstellt,
aus der heraus Mitarbeiter Bestell - Emails per Outlook versenden können.

Das hat bisher anstandslos funktioniert.

Nach Click auf ein Shape innerhalb der Bestellzeile, welches als Sendebutton fungiert, wird einen Email versendet und eine neue Bestellzeile angelegt.
Anschließend werden die Zellen der neuen Bestellzeile wieder für neue Einträge geleert.

Bisher hatten die neu kopierten Shapes immer einen neuen Namen erhalten.
Nun haben jedoch die kopierten Shapes den gleichen Namen wie die Ausgangsshapes, was zu Problemen führt.

Der einzige Unterschied zu meinem Arbeitscomputer ist, dass ich hier kein Outlook verwende, aber auch in der Vergangenheit hat es funktioniert.



Sub ZeileKopierenUndEinfügen()



       'Was ist i - > i ist die Zeile SendEmail + 1

        

       'Bestimmen in welcher Reihe auf OK Button Sendebutton geklickt wurde



            OKBtn1Reihe = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row           

            i = OKBtn1Reihe          

            

        With Application

            .EnableEvents = False



                    Range("A" & i & ":U" & i).Select

            

                    Selection.AutoFill Destination:=Range("A" & i & ":U" & i + 1), Type:=xlFillDefault



                    Range("A" & i & ":U" & i + 1).Select

             

                    Range("A" & i + 1).Select

            

                    ' Die Daten der vorherigen Zeile werden in der kopierten Zeile gelöscht - > Blancozeile

                    ActiveSheet.Range(ActiveSheet.Cells(OKBtn1Reihe + 1, 2), ActiveSheet.Cells(OKBtn1Reihe + 1, 11)).Value = ""   

                    'ActiveSheet.Range(ActiveSheet.Cells(OKBtn1Reihe + 1, 14), ActiveSheet.Cells(OKBtn1Reihe + 1, 16)).Value = ""

                    ActiveSheet.Range(ActiveSheet.Cells(OKBtn1Reihe + 1, 14), ActiveSheet.Cells(OKBtn1Reihe + 1, 15)).Value = ""  

        

                    '***Focus auf Datum der neuen Eintragszelle setzen

                    'LetzteZeile : = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

                    Range("B" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row).Select

                    Range("B" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row).Value = Date

                    

            .EnableEvents = True

        End With



End Sub

Ich habe versucht die Shapes alle in einer Schleife umzubenennen, was auch funktioniert, beim letzten oder nach dem letzen Shape erhalte ich jedoch einen Fehler 1004.



Sub neuMarkieren()

Dim sh As Shape

For Each sh In Me.Shapes

sh.Name = "Marker" & sh.TopLeftCell.Address(0, 0)

Next sh

End Sub

Wenn ich mir die Namen der Shapes anzeigen lassen, tauchen später einige doppelt auf und als letztes ein Dropdown,
wobei ich in einer Zelle ganz oben ein Dropdownmenü mit Namensauswahl für den Emailabsender habe.

Eine andere Variante wäre noch, alles über einen einzigen Sendebutton zu machen, wobei die Anwender dann nach oben scrollen müßten
und die Anwendung umprogrammiert werden müßte.

Gibt es dazu eine irgendeine Lösung?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Namensgleichheit kopierter Shapes

29.10.2024 13:00:22

Onur

"Bisher hatten die neu kopierten Shapes immer einen neuen Namen erhalten. " ? Ich sehe im oberen Code nix, was irgendwas kopiert, geschweige denn Shapes.
Warum postest du nicht die Datei statt ein paar Codefetzen ?
"Wenn ich mir die Namen der Shapes anzeigen lassen, tauchen später einige doppelt auf" ? Das kann eigentlich nie passieren.

AW: Namensgleichheit kopierter Shapes

31.10.2024 06:52:51

Selfmade

Vielen Dank für deine Antwort, hier ist eine sehr frühe Version.
In jeder Bestellzeile befinden sich 2 Shapes, die nach Emailversand in die neu angelegte Zeile kopiert werden.
Sie besitzen den gleichen Namen wie in der Vorgängerzeile. Klicke ich auf den kopierten Button, versteht Excel, dass ich auf den Ursprungsbutton geklickt habe.
Da ich an diesem Code seit 2021 nichts geändert habe, verstehe ich nicht, warum nun dieser Fehler auftritt und wie ich ihn beheben kann.

https://www.herber.de/bbs/user/173314.xlsm

VG Self

AW: Namensgleichheit kopierter Shapes

29.10.2024 16:04:27

Yal

Hallo Self (man spricht sich im Forum per Vorname an),

Wenn zufälligerweise 2 Shapes innerhalb demselben Zelle vorkommen, dann wird dein Code versuchen zweimal dieselbe Name zu vergeben.
Achte auf ein sauberes Einrücken. Das A&O um schneller lernen:

Sub neuMarkieren()

Dim sh As Shape



    For Each sh In Me.Shapes

        sh.Name = "Marker" & sh.TopLeftCell.Address(0, 0)

    Next sh

End Sub

Dein oberen Code könnte auch so aussehen:

Sub ZeileKopierenUndEinfügen()

    Application.EnableEvents = False

    With ActiveSheet.Shapes(Application.Caller).TopLeftCell.EntireRow 'für die aktuelle Zeile

        .Offset(1).ClearContents 'nach der aktuelle Zeile alles leeren

        .Range("L:M").Resize(2).FillDown 'kopiere von L bis M vom akt. Zeile eine Zeile nach unten

    End With

'Letzte befüllte Zelle in Spalte A, davon ein Spalte nach rechts

    ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(, 1).Value = Date

    Application.EnableEvents = True

End Sub

VG
Yal

AW: Namensgleichheit kopierter Shapes

31.10.2024 06:59:02

Selfmade

Hallo Yal,

vielen Dank für deine Antwort, der Code gibt mir eine 1004 Fehlermeldung zurück. Er ist aber sehr schön kurz.

Ich habe hier eine frühe Version zum Testen eingestellt.

https://www.herber.de/bbs/user/173314.xlsm

VG Self

AW: Namensgleichheit kopierter Shapes

10.11.2024 10:31:04

Selfmade

Mit dem bereits geposteten Code und der Abänderung von me.shapes in ActiveSheet.Shapes konnte ich nun die Shapes umbenennen.
Bisher wurde mir der Fehlercode 1004 angezeigt, obwohl ich das Blatt innerhalb des Codes mit unprotect meinte entsperrt zu haben.
Nachdem ich es heute nochmal neu versucht habe, hat es geklappt.



Sub neuMarkieren()

Dim sh As Shape

    For Each sh In ActiveSheet.Shapes

        sh.Name = "Marker" & sh.TopLeftCell.Address(0, 0)

    Next sh

End Sub

End Sub

Vielen Dank an das Forum.

AW: Namensgleichheit kopierter Shapes

31.10.2024 11:18:47

Yal

Hallo Self,

beachtlich, was Du im Selbststudium auf die Beine gestellt hast. Es ist natürlich ein Wuseln an Code, der für Außenstehenden schwer durchschaubar ist.

Ich denke, das beste/einfachste ist, dir ein Paar Tipps, um schneller voranzukommen.

Mit folgenden Code bekommst Du eine Übersicht über alle Shape-Namen. Spoiler: es darf in Excel grundsätzlich keine Objektnamen doppelt sein.

Sub Test()

Dim ws As Worksheet

Dim S As Shape



' läuft durch jede Arbeitsblatt 

    For Each ws In ThisWorkbook.Worksheets

    ' läuft darin über jeden Shape

        For Each S In ws.Shapes

            Debug.Print ws.Name, S.Name

        Next

    Next

End Sub

Im allgemein:
- achte auf einem sauberen Einrücken (Extras, Optionen..., Tab-Schrittweite= 4). Das A&O des guten Codes!
- verzichte auf unnötige Leerzeilen. Sie erhöhen keinesfalls die Lesbarkeit, ganz im Gegenteil.
- Kommentar ist oft gleichzeitig "Kapitelüberschrift": vorrücken.
- kommentiere nicht was offensichtlich ist (genau was ich gerade oben ignoriert habe ;-)

VG
Yal

Beliebteste Forumthreads (12 Monate)

Namensgleichheit kopierter Shapes

Forumthread: Namensgleichheit kopierter Shapes

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread