Results 1 to 5 of 5

Excel VBA - Delete Shapes in a Range

This is a discussion on Excel VBA - Delete Shapes in a Range within the Excel Questions forums, part of the Question Forums category; Hello; I have an Excel application I'm using to import product images and allow the user to supply information about ...

  1. #1
    New Member
    Join Date
    Mar 2004
    Location
    San Diego, California, US
    Posts
    11

    Default Excel VBA - Delete Shapes in a Range

    Hello;

    I have an Excel application I'm using to import product images and allow the user to supply information about their products. After selecting images to insert, I'm using this code to insert filenames and thumbnails:

    For f = 1 To UBound(files)
    .[b65536].End(3)(2) = files(f)
    .Range("C" & .[b65536].End(3).Row).Select
    Selection.EntireRow.RowHeight = 36
    With ActiveSheet.Pictures.Insert(files(f))
    .ShapeRange.Height = 36
    .Name = Right(files(f), Len(files(f)) - InStrRev(files(f), "\"))

    I have a command button on the page to clear (reset) the sheet; but, I don't want to clear all images...just the images that were imported.

    I'm using the following code which still seems to delete every image:

    For Each shp In ActiveSheet.Shapes
    If shp.Name <> "Picture2" Then shp.Delete
    Next

    Can anyone tell me how to code it so I only delete shapes imported in the above range? Thanks In Advance!

  2. #2
    Board Regular
    Join Date
    Jun 2002
    Location
    Perth, Australia
    Posts
    1,416

    Default Re: Excel VBA - Delete Shapes in a Range

    Rick,

    The reason why your code is deleting all pictures is because the code refers to the ActiveSheet.

    For Each shp In ActiveSheet.Shapes
    If shp.Name <> "Picture2" Then shp.Delete
    Next

    Try this (deletes all pictures in the range C1:C50):
    Code:
    Sub Test()
    Dim Sh As Shape
    With Worksheets("Sheet1")
       For Each Sh In .Shapes
           If Not Application.Intersect(Sh.TopLeftCell, .Range("C1:C50")) Is Nothing Then
             If Sh.Type = msoPicture Then Sh.Delete
           End If
        Next Sh
    End With
    End Sub
    HTH

    Mike

  3. #3
    Board Regular
    Join Date
    Jun 2002
    Location
    Perth, Australia
    Posts
    1,416

    Default Re: Excel VBA - Delete Shapes in a Range

    Rick,

    Just noted, in your macro snippet you do not want to delete Picture 2. Change the previous macro to:
    Code:
    Sub Test()
    Dim Sh As Shape
    With Worksheets("Sheet1")
       For Each Sh In .Shapes
           If Not Application.Intersect(Sh.TopLeftCell, .Range("A1:A50")) Is Nothing Then
             If Sh.Name <> "Picture 2" And Sh.Type = msoPicture Then Sh.Delete
           End If
        Next Sh
    End With
    End Sub
    Regards,

    Mike

  4. #4
    New Member
    Join Date
    Mar 2004
    Location
    San Diego, California, US
    Posts
    11

    Default Re: Excel VBA - Delete Shapes in a Range

    Thank you Mike! Works like a charm. Thanks very much for your time.

  5. #5
    New Member
    Join Date
    Feb 2012
    Posts
    1

    Default Re: Excel VBA - Delete Shapes in a Range

    help
    It works for me as an isolated Sub, but i have my code like this:

    ...
    Select Case usu
    Case Hoja7.Range("B23").Value
    If pass = pass1 Then
    Sheets("Sec Data").Select
    Range("E24").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("F6").Select
    ActiveSheet.Paste
    Else
    'f6
    Sheets("Summary").Select
    With ActiveSheet
    If ActiveSheet.Shapes.Count > 0 Then
    For Each Sh In .Shapes
    If Not Application.Intersect(Sh.TopLeftCell, .Range("F6")) Is Nothing Then
    If Sh.Type = msoPicture Then
    Sh.Delete
    End If
    End If
    Next Sh
    End If
    End With
    'Sheet1.Range("F6").Value = "Incorrecto"
    End If
    ...more cases

    It gives the 1004 Error "defined by the application or object"
    If I debug, the line:
    If Not Application.Intersect(Sh.TopLeftCell, .Range("F6")) Is Nothing Then
    turns yellow..
    please, help

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com