Can you check my code please

[ipbr21054]

Hi,
I wish to delete a photo when the worksheet is closed.
My code that runs when i close the sheet is supplied below.

I have just run the code and noticed that on the sheet DR PDF it has deleted the command button 1 & 2
The code is still on the sheet but the 2 buttons are gone.

HAVING SAID THAT

The sheet EBAY PRINT has the same code & same buttons but these were not touched.

Basically i dont need these command buttons deleted.

On a side note the photos that i did want deleting were actually deleted so that part is fine.

Private Sub Workbook_BeforeClose(Cancel As Boolean)Application.ScreenUpdating = False
Sheets("Sheet1").Range("P1:U1").Copy Sheets("Sheet1").Range("E6")
Sheets("Sheet1").Range("P2").Copy Sheets("Sheet1").Range("E7")


Sheets("DR PDF").Range("E6:J6").ClearContents
ActiveSheet.Pictures.Delete


Sheets("EBAY PRINT").Range("E6:J6").ClearContents
ActiveSheet.Pictures.Delete


Sheets("DR PDF").Range("E7").ClearContents


Sheets("EBAY PRINT").Range("E7").ClearContents


Application.ScreenUpdating = True
ActiveWorkbook.Save
End Sub

 

[Domenic]

Pictures.Delete will delete commandbuttons (and other objects) in addition to pictures. Therefore, you'll need to loop through each shape and test whether the shape is a picture. If so, then delete it. Also, as per your current code, Pictures.Delete is performed on the the active sheet each time. So, since you haven't activated another sheet, the second Pictures.Delete is performed on the same sheet. Try the following instead...

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim currentShape As Shape


    Application.ScreenUpdating = False
    
    With Sheets("Sheet1")
        .Range("P1:U1").Copy .Range("E6")
        .Range("P2").Copy .Range("E7")
    End With
    
    With Sheets("DR PDF")
        .Range("E7,E6:J6").ClearContents
        For Each currentShape In .Shapes
            If currentShape.Type = msoPicture Then
                currentShape.Delete
            End If
        Next currentShape
    End With
    
    With Sheets("EBAY PRINT")
        .Range("E7,E6:J6").ClearContents
        For Each currentShape In .Shapes
            If currentShape.Type = msoPicture Then
                currentShape.Delete
            End If
        Next currentShape
    End With
    
    Application.ScreenUpdating = True
    
    ActiveWorkbook.Save
    
End Sub

Hope this helps!

 

[ipbr21054]

Thanks that did the trick.