Check if shape exist

[Hans Hubers]

I am creating shapes, but the user can delete them. Then if the VBA code
wants to updat the shape with some information in cells, the code should
check if the shape exists and otherwise create it.

 

[Gary''s Student]

Adapt something like:

Sub Macro2()
On Error GoTo placeit:
ActiveSheet.Shapes("Oval 1").Select
MsgBox ("found it")
Exit Sub

placeit:

ActiveSheet.Shapes.AddShape(msoShapeOval, 292.5, 135.75, 100.5, 48#).Select
MsgBox ("made it")
End Sub

 

[Norman Jones]

Hi Hans,

Try something like:

'==========>>
Public Sub Tester()
Dim SH As Worksheet
Dim SHP As Shape
Const sShape As String = "Rectangle 1"

Set SH = ThisWorkbook.Sheets("Sheet1")

With SH
On Error Resume Next
Set SHP = .Shapes(sShape)
On Error GoTo 0

If Not SHP Is Nothing Then
'\\ your code
Else
Set SHP = .Shapes.AddShape _
(Type:=msoShapeRectangle, _
Left:=20, _
Top:=50, _
Width:=100, _
Height:=50)
End If
End With
End Sub
'<<==========

 

[Norman Jones]

Hi Hans,

Better would be something like:

'==========>>
Public Sub Tester()
Dim SH As Worksheet
Dim SHP As Shape
Dim Rng As Range
Const sShape As String _
= "Rectangle 1" '<<==== CHANGE

Set SH = ThisWorkbook. _
Sheets("Sheet1") '<<==== CHANGE

With SH
Set Rng = Range("A2") '<<==== CHANGE
On Error Resume Next
Set SHP = .Shapes(sShape)
On Error GoTo 0

If SHP Is Nothing Then
Set SHP = .Shapes.AddShape _
(Type:=msoShapeRectangle, _
Left:=20, _
Top:=50, _
Width:=100, _
Height:=50)
End If
End With

'\\ your code, e.g.:
With SHP
.TextEffect.Text = Range("A1").Value
.Name = sShape
End With
End Sub
'<<==========