Excel VBA - Check if shape exists


I am fairly new to VBA, and I am creatng invoices that are as generic as possible, which means that the user will decide where their company logo will be written, either the left or right of the sheet.  Now I have the code to successfully do this, and it moves around 3 shapes, an image box, and 2 text boxes.  Now, my problem is this, on some sheets, there is only a logo, on some there is a logo and one text box.  Please can someone help me add a check to see if the shape exists first, and then only must it continnue to move them.  At the moment, I get an error if I try to move a shape that does not exist.  See code below. CompInfo.xlsm
Option Explicit

Sub LeftInvoiceLogo()
'Put customer logo and letterhead on left, CustomerBox on right
PositionLogo True
End Sub

Sub RightInvoiceLogo()
'Put customer logo and letterhead on right, CustomerBox on left
PositionLogo False
End Sub

Sub PositionLogo(bLeft As Boolean)
Dim shpLogo As Shape, shpLetterhead As Shape, shpCustomerBox As Shape, shpCustomerBoxLabel As Shape
Dim LeftEdge As Double, RightEdge As Double
Dim cel As Range, rgHeader As Range

Set rgHeader = Range("A1").MergeArea    'Merged cell range that extends from left extreme to right extreme of invoice
LeftEdge = rgHeader.Left
RightEdge = LeftEdge
For Each cel In rgHeader.Rows(1).Cells
    RightEdge = RightEdge + cel.Width
  Set shpLogo = ActiveSheet.Shapes("ImageLogo")
  Set shpLetterhead = ActiveSheet.Shapes("LetterHead")
  Set shpCustomerBox = ActiveSheet.Shapes("invCustomerBox")
  Set shpCustomerBoxLabel = ActiveSheet.Shapes("invCustomerBoxLabel")

If bLeft = True Then
    shpLogo.Left = LeftEdge
    shpLetterhead.Left = LeftEdge
   With Selection
       .HorizontalAlignment = xlLeft
   End With
    shpCustomerBox.Left = RightEdge - shpCustomerBox.Width - 5
    Range("E4:E12").Value = Range("B4:B12").Value
    With Selection
      .HorizontalAlignment = xlLeft
    End With
    shpLogo.Left = RightEdge - shpLogo.Width - 5
    shpLetterhead.Left = RightEdge - shpLetterhead.Width - 5
    shpCustomerBox.Left = LeftEdge
    Range("B4:B12").Value = Range("E4:E12").Value
End If
shpCustomerBoxLabel.Left = shpCustomerBox.Left + 223.5
End Sub

Open in new window

Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

TracyVBA DeveloperCommented:
Give this a try:

You would call it like this and in the quotes add the name of the shape you're checking:

CheckShapeExists("Check Box 1")

Function CheckShapeExists(shpName As String)

    Dim myShapes As Shape
    Dim blnFound As Boolean
    blnFound = False
    For Each myShapes In ActiveSheet.Shapes
        If myShapes.Name = shpName Then
            blnFound = True
            Exit For
        End If
    If blnFound Then
        MsgBox "The " & shpName & " shape exists."
        MsgBox "The " & shpName & " shape does not exist."
    End If

End Function

Open in new window

Travis HydzikVariousCommented:
use the following funciton, it takes the shape name and returns a boolean.
it looks at the active sheet.
Function shapeExists(ByRef shapename As String) As Boolean

    shapeExists = False
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        If sh.Name = shapename Then
            shapeExists = True
            Exit Function
        End If
    Next sh

End Function

Open in new window


or even

Dim shpLogo As Shape

On Error Resume Next
Set shpLogo = ActiveSheet.Shapes("ImageLogo")
On Error GoTo 0

If Not shpLogo Is Nothing Then
    'your code here
End If


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
NerishaBAuthor Commented:
Thanks, the solution frishnakrkc worked perfectly for me.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.