Deleting an image

**treva26** · 07-17-2007, 03:50 AM

I have created a macro that inserts some data and a drawing into a template and then saves it with a new name.

But I am having a problem deleting the old drawing.

Could the problem be that my drawing is a "shape" ?
Or not really in the cell M1 as I intended?
Or could I give the drawing a name when I insert it, then delete it by name next time around?

Unfortunately my workbook is 150k so I cant upload it here, but I could email it to anyone who is interested.

My code looks like this:

Sub autofill1()

Application.ScreenUpdating = False

On Error GoTo error1:

' Prepare variables
Dim p As Object, t As Double, l As Double, w As Double, h As Double
Dim ProductCode
Dim MaterialCode
Dim DrawingCode
Dim ProductFilename
Dim NewFileName

' Remove existing data
Sheets("Production Sheet").Activate
Cells(5, 3) = ""
Cells(9, 10) = ""
Cells(5, 7) = ""


'Remove old drawing
Cells(1, "M") = ""
'or
Range("M1:W40").Select
Selection.ClearContents



' Input the Product number
ProductCode = InputBox("Please enter the Product code")
If ProductCode = "" Then
  MsgBox ("Error - No Product Code")
  Exit Sub
End If

'Lookup the required info
On Error GoTo error1:
Sheets("Product List").Activate
MaterialCode = Application.VLookup(ProductCode, Range("A1:M800"), 4, False)
DrawingCode = Application.VLookup(ProductCode, Range("A1:M800"), 11, False)
ProductFilename = "M:\Mining\Manufacturing\Production Control\BLADE PRODUCTS FOLDERS\VERTICAL\" & ProductCode & ".gif"
NewFileName = "M:\Mining\Manufacturing\Production Control\Blade Production Sheets\" & ProductCode & ".xls"

' Put the data on the template
Sheets("Production Sheet").Activate
Cells(5, 3) = ProductCode
Cells(9, 10) = MaterialCode
Cells(5, 7) = DrawingCode

' Insert the drawing and resize it
On Error GoTo nopic:
    Cells(1, "M").Select
    Set p = ActiveSheet.Pictures.Insert(ProductFilename)
    With p
        .Width = 505
        .Height = 795
    End With
   Set p = Nothing

Application.ScreenUpdating = True

' Save As the product code
On Error GoTo nosave:
    ActiveWorkbook.SaveAs Filename:=NewFileName _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

'End of main subroutine
Exit Sub



'Error Handling

nopic:
MsgBox ("No drawing was found. This Production Sheet was not saved.")
Exit Sub

nosave:
MsgBox ("The Production Sheet could not be saved.")
Exit Sub

error1:
MsgBox ("There was an error with the Product Code or WorkBook. This Production Sheet was not saved.")
Exit Sub

End Sub

**Leith Ross** · 07-17-2007, 05:05 AM

Hello treva26,

'Delete a single Picture
  ActiveSheet.Pictures(1).Delete

'Delete All Pictures
  Dim Pic As Object

    For Each Pic In ActiveSheet.Pictures
      Pic.Delete
    Next Pic

Sincerely,
Leith Ross

**treva26** · 07-17-2007, 08:00 PM

No thats not working.
I have other pictures on the worksheet that I dont want to delete.

The one I do want to delete is (or should be) in M1.
Its the one I insert later in the macro, can I set its name or label when I insert it? Then delete it by name later?

' Insert the drawing and resize it
On Error GoTo nopic:
    Cells(1, "M").Select
    Set p = ActiveSheet.Pictures.Insert(ProductFilename)
    With p
        .Width = 505
        .Height = 795
        .Name = Drawing1
    End With
   Set p = Nothing

**treva26** · 07-17-2007, 08:18 PM

I have managed to get a small enough version to post on here:

**rylo** · 07-17-2007, 08:40 PM

Hi

In your code you don't actually give it a name that I can see as Drawing1 is a variable that is not set.

Change

.Name = Drawing1

to

.Name = "Drawing1"

The picture will then have a name.

You can then delete it with

ActiveSheet.Pictures("Drawing1").Delete

rylo

**Leith Ross** · 07-17-2007, 08:46 PM

Hello treva26,

Copy and paste this macro into Module 2.

Sub DeletePic()

  Dim Pic As Object
  
    For Each Pic In Worksheets("Production Sheet").Pictures
      If Not Intersect(Pic.TopLeftAddress, Range("M1")) Is Nothing Then
         Pic.Delete
         Exit For
      End If
    Next Pic

End Sub

Sincerely,
Leith Ross

**mikerickson** · 07-17-2007, 08:48 PM

Shapes are not in cells.

Range("M1:W40").Select
Selection.ClearContents

will not delete any shapes.

A shape does have a .TopLeftCell which is one way to see where it is.
This will look at all shapes on sheet 1 and delete any of them whose TopLeft is M1.

Sub deleteAShape()
Dim xShape As Shape

For Each xShape In ThisWorkbook.Sheets("sheet1").Shapes
    If xShape.TopLeftCell.Address = "$M$1" Then xShape.Delete
Next xShape

End Sub