If Befehl und Name eines Shapes

Forumthread: If Befehl und Name eines Shapes

25.06.2019 13:07:35

Leon.DerProf

Hallo alle zusammen,
ich hoffe der Code-Auszug ist hinreichend verständlich.


Set sh = ActiveSheet.Shapes.AddShape(msoShapePentagon, ActiveCell.Left, ActiveCell.Top,  _
ActiveCell.Height, ActiveCell.Height)
sh.Select
With Selection
.Characters.Text = fte & " FTE"
.Placement = xlMoveAndSize
.name = "Zeit " & festNr
End With
Set rng = Worksheets("Balkenplan").Range(Cells(findenNr.Row, findenstart.Column).Address)
Set shp = Worksheets("Balkenplan").Shapes("Zeit " & festNr)
shp.Left = rng.Left
shp.Top = rng.Top
shp.Width = Range(findenstart.Address, findenende.Address).Width

Es wird im Grunde vorher ein Zelleninhalt angepeilt und dieser als Name für das Shape benutzt.
Soweit so gut.
Nun sehe ich das Problem, wenn versehentlich der selbe Name für ein Shape verwendet wird, sprich der gleiche Befehl auf die gleiche Weise zweimal angewendet wird, dann gibt es zwei Shapes mit dem selben Namen und das zweite Shape reagiert natürlich nicht auf das Makro (verschiebt, streckt oder staucht sich also nicht).
D.h. ich möchte eine Kniff einbauen, so dass bei einem gleichen Namen mit MsgBox ausgegeben wird, dass das nicht zulässig ist und zugleich soll das Objekt nicht erstellt warden bzw. das Makro vor "AddShape" abgebrochen warden.
Ich habe überlegt einen If-Befehl einzubauen, weiß aber ehrlich gesagt nicht so richtig wo ich es platzieren soll.
Die zeitliche Abfolge des Makros macht das ganze etwas tricky

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: If Befehl und Name eines Shapes

25.06.2019 13:12:11

Leon.DerProf
AW: If Befehl und Name eines Shapes

25.06.2019 13:38:16

Leon.DerProf
Hier ein Beispiel,...

25.06.2019 13:39:35

Case
AW: Hier ein Beispiel,...

25.06.2019 13:41:33

Leon.DerProf
AW: Hier ein Beispiel,...

26.06.2019 09:29:59

Nepumuk

AW: If Befehl und Name eines Shapes

25.06.2019 13:12:11

Leon.DerProf

If shapes("Zeit " & festNr) is Nothing then
...
Else goto Ende
End If
..
Ende=MsgBox "Funktioniert nicht"
End Sub
Vielleicht irgendwie so?
Also wenn ein Shape mit diesem Namen nicht existiert, dann... sonst

AW: If Befehl und Name eines Shapes

25.06.2019 13:38:16

Leon.DerProf

Also so funktioniert es, WENN bereits ein Shape mit dem Namen existiert, dann bricht der Makro ab.
Wenn so ein Shape noch nicht existiert, dann kommt die Fehlermeldung, dass das Objekt nicht gefunden wurde.

If Worksheets("Balkenplan").Shapes("Zeit " & festNr) Is Nothing Then
Set sh = ActiveSheet.Shapes.AddShape(msoShapePentagon, ActiveCell.Left, ActiveCell.Top,  _
ActiveCell.Height, ActiveCell.Height)
sh.Select
With Selection
.Characters.Text = fte & " FTE"
.Placement = xlMoveAndSize
.name = "Zeit " & festNr
End With
Set rng = Worksheets("Balkenplan").Range(Cells(findenNr.Row, findenstart.Column).Address)
Set shp = Worksheets("Balkenplan").Shapes("Zeit " & festNr)
shp.Left = rng.Left
shp.Top = rng.Top
shp.Width = Range(findenstart.Address, findenende.Address).Width
Else: MsgBox "Dieser Zeitstrahl existiert bereits"
End If

Soll ich einen OnError GoTo einbauen oder wird es langsam unelegant?

Hier ein Beispiel,...

25.06.2019 13:39:35

Case

Hallo, :-)
... der Rest muss von dir kommen: ;-)
Beispieldatei...
Servus
Case

AW: Hier ein Beispiel,...

25.06.2019 13:41:33

Leon.DerProf


Worksheets(2).Activate
Cells(findenNr.Row, findenstart.Column).Select
On Error GoTo AblaufenGo
If Worksheets("Balkenplan").Shapes("Zeit " & festNr) Is Nothing Then
AblaufenGo:
Set sh = ActiveSheet.Shapes.AddShape(msoShapePentagon, ActiveCell.Left, ActiveCell.Top,  _
ActiveCell.Height, ActiveCell.Height)
sh.Select
With Selection
.Characters.Text = fte & " FTE"
.Placement = xlMoveAndSize
.name = "Zeit " & festNr
End With
Set rng = Worksheets("Balkenplan").Range(Cells(findenNr.Row, findenstart.Column).Address)
Set shp = Worksheets("Balkenplan").Shapes("Zeit " & festNr)
shp.Left = rng.Left
shp.Top = rng.Top
shp.Width = Range(findenstart.Address, findenende.Address).Width
Exit Sub
Else: MsgBox "Dieser Zeitstrahl existiert bereits"
End If

So habe ich es hinbekommen. Die ersten AHA Momente und Freude pur :D
Aber ich bin mir nicht sicher, ob dieser Code stümperhaft ist. Er funktioniert aber

AW: Hier ein Beispiel,...

26.06.2019 09:29:59

Nepumuk

Hallo Leon,
das geht auch ohne Select-Methode:

    With ActiveCell
Set sh = ActiveSheet.Shapes.AddShape(msoShapePentagon, .Left, .Top, .Height, .Height)
End With
With sh
.TextFrame2.TextRange.Characters.Text = fte & " FTE"
.Placement = xlMoveAndSize
.Name = "Zeit " & festNr
End With

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Forumthread: If Befehl und Name eines Shapes

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread