Check if shape exist

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Hans Hubers - 26 May 2008 13:28 GMT

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.

Reply to this Message

Gary''s Student - 26 May 2008 13:41 GMT

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

Signature

Gary''s Student - gsnu200788

> 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.

Reply to this Message

Norman Jones - 26 May 2008 14:24 GMT

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
'<<==========

---
Regards.
Norman

>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.

Reply to this Message

Norman Jones - 26 May 2008 14:45 GMT

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
'<<==========

---
Regards.
Norman

Reply to this Message