Delete shape before inserting new one ?

fredrerik84

Active Member
Joined
Feb 26, 2017
Messages
383
Hi I started an quite similar thread earlier today but it was a little confusing so I have a better question this time around.

im working on a code (still on test bench) but here is what I got:

Code:
Sub shape2017()
Dim LogoPath As String
Dim j As Long
Dim ws As Worksheet: Set ws = Worksheets("Data")
j = 51

LogoPath = ThisWorkbook.Path & "\Icons\" & Cells(j, "G") & ".png"

With ActiveSheet.Pictures.Insert(LogoPath)
    With .ShapeRange
        .LockAspectRatio = False
         .Width = 30
         .Height = 18
    End With
    .Left = ActiveSheet.Cells(653, 6).Left + 1
    .Top = ActiveSheet.Cells(653, 6).Top - 0.5
    .Placement = 1
    .PrintObject = True
End With
End Sub

So this works as expected, but Cells(653, 6) already has an img from before. How can I delete this shape before inserting a new one ?
, and the same cell also has a dropdown menu.

anyone know a way to handle this ? would be much appreciated
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
frederik84,

You might consider the following...

Code:
Sub shape2017()
Dim shp As Shape
Dim LogoPath As String
Dim j As Long
Dim ws As Worksheet: Set ws = Worksheets("Data")
j = 51

For Each shp In ActiveSheet.Shapes
    If shp.Left = ActiveSheet.Cells(653, 6).Left + 1 _
         And shp.Top = ActiveSheet.Cells(653, 6).Top - 0.5 Then shp.Delete
    Exit For
Next shp

LogoPath = ThisWorkbook.Path & "\Icons\" & Cells(j, "G") & ".png"

With ActiveSheet.Pictures.Insert(LogoPath)
    With .ShapeRange
        .LockAspectRatio = False
         .Width = 30
         .Height = 18
    End With
    .Left = ActiveSheet.Cells(653, 6).Left + 1
    .Top = ActiveSheet.Cells(653, 6).Top - 0.5
    .Placement = 1
    .PrintObject = True
End With
End Sub

Cheers,

tonyyy
 
Upvote 0
Hi, thanks for your reply. This seams correct but for some reason its not working. I think maybe the problems is because ive offset the shape from top, left here is what ive tried for debugging :

Code:
For Each shp In ActiveSheet.Shapes
    If shp.Left = ActiveSheet.Cells(653, 6).Left + 1 _
         And shp.Top = ActiveSheet.Cells(653, 6).Top - 0.5 Then
            shp.Delete
            MsgBox "found"
        End If
    Exit For
Next shp
 
Upvote 0
Never mind the exit for messed it up.

corrected to this:

Code:
For Each shp In ActiveSheet.Shapes
    If shp.Left = ActiveSheet.Cells(653, 6).Left + 1 _
       And shp.Top = ActiveSheet.Cells(653, 6).Top - 0.5 Then
          shp.Delete
          Exit For
    End If
Next shp

finally its working . , thanks! you are the best , cheers
 
Upvote 0
You're welcome. Glad you got it working...
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,185
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top