Images Won't Delete

rodl66

New Member
Joined
Mar 8, 2023
Messages
26
Office Version
  1. 365
Platform
  1. Windows
Hello Excel Gurus!

I have an inspection worksheet where I use checkboxes, text and select images from the computer that get pasted in specific cells. I have created a "Clear Checklist" button that is coded to clear all checkboxes, text and images; however, the images are not getting deleted. The other items I want cleared work fine, just not the pictures. My code follows and I appreciate any help provided. Thank you.

Sub ClearCellsTypeC()

Dim ws As Worksheet
Dim c As Object
Dim shp As Shape
Dim shpA As Object
Dim originalCell As Range

Set ws = ThisWorkbook.Sheets("TYPE C")
Set originalCell = ws.Range("E1")

Range("B16:B26").ClearContents

Dim tb As OLEObject
For Each tb In ActiveSheet.OLEObjects
If TypeName(tb.Object) = "TextBox" Then
tb.Object = " "
End If
Next tb

For Each c In ActiveSheet.OLEObjects
If InStr(1, c.Name, "CheckBox") > 0 Then
c.Object.Value = False
End If
Next c

For Each shp In ws.Shapes
If shp.Type = msoPicture Then
shp.Delete
End If
Next shp

For Each shpA In ws.OLEObjects
If TypeName(shpA.Object) = "Picture" Then
shpA.Delete
End If
Next shpA

'Return to the original cell
originalCell.Select

End Sub
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Are you sure there are images to be deleted, or that your code recognizes what you are defining as an 'image'?

VBA Code:
Sub CountSheetImages()
   
    Dim ws As Worksheet
    Dim shp As Shape
    Dim shpA As Object
    Dim PictureCnt As Long, msoPictureCnt As Long
   
    Set ws = ThisWorkbook.Sheets("TYPE C")
   
    Range("B16:B26").ClearContents
   
    For Each shp In ws.Shapes
        If shp.Type = msoPicture Then
            'shp.Delete
            msoPictureCnt = msoPictureCnt + 1
        End If
    Next shp
   
    For Each shpA In ws.OLEObjects
        If TypeName(shpA.Object) = "Picture" Then
            'shpA.Delete
             PictureCnt = PictureCnt + 1
        End If
    Next shpA
   
    MsgBox "msoPictures: " & msoPictureCnt & vbCr & "Pictures: " & PictureCnt, , "Image Count"
End Sub


(Tip: For future posts , please try to use code tags like I did above when posting code. It makes your code easier to read and copy.
)
 
Upvote 0
Are you sure there are images to be deleted, or that your code recognizes what you are defining as an 'image'?

VBA Code:
Sub CountSheetImages()
  
    Dim ws As Worksheet
    Dim shp As Shape
    Dim shpA As Object
    Dim PictureCnt As Long, msoPictureCnt As Long
  
    Set ws = ThisWorkbook.Sheets("TYPE C")
  
    Range("B16:B26").ClearContents
  
    For Each shp In ws.Shapes
        If shp.Type = msoPicture Then
            'shp.Delete
            msoPictureCnt = msoPictureCnt + 1
        End If
    Next shp
  
    For Each shpA In ws.OLEObjects
        If TypeName(shpA.Object) = "Picture" Then
            'shpA.Delete
             PictureCnt = PictureCnt + 1
        End If
    Next shpA
  
    MsgBox "msoPictures: " & msoPictureCnt & vbCr & "Pictures: " & PictureCnt, , "Image Count"
End Sub


(Tip: For future posts , please try to use code tags like I did above when posting code. It makes your code easier to read and copy.
)
Thank you for the code tag information, I forgot about that, my apologies.

Yes, when I have images in the specific cells, they remain while the check and text boxes get cleared.
 
Upvote 0
Are you sure there are images to be deleted, or that your code recognizes what you are defining as an 'image'?

VBA Code:
Sub CountSheetImages()
  
    Dim ws As Worksheet
    Dim shp As Shape
    Dim shpA As Object
    Dim PictureCnt As Long, msoPictureCnt As Long
  
    Set ws = ThisWorkbook.Sheets("TYPE C")
  
    Range("B16:B26").ClearContents
  
    For Each shp In ws.Shapes
        If shp.Type = msoPicture Then
            'shp.Delete
            msoPictureCnt = msoPictureCnt + 1
        End If
    Next shp
  
    For Each shpA In ws.OLEObjects
        If TypeName(shpA.Object) = "Picture" Then
            'shpA.Delete
             PictureCnt = PictureCnt + 1
        End If
    Next shpA
  
    MsgBox "msoPictures: " & msoPictureCnt & vbCr & "Pictures: " & PictureCnt, , "Image Count"
End Sub


(Tip: For future posts , please try to use code tags like I did above when posting code. It makes your code easier to read and copy.
)
Correction, I ran your code and it returned ZERO!
 
Upvote 0
Correction, I ran your code and it returned ZERO!

That's because the objects you are identifying as images are not what you are testing for with If shp.Type = msoPicture Then and If TypeName(shpA.Object) = "Picture" Then. You'll need to figure out their exact type
 
Upvote 0
I got it finally...

I used:
VBA Code:
For Each shp In ActiveSheet.Shapes

If shp.Type = msoPicture Or shp.Type = msoLinkedPicture Then

shp.Delete

End If

Next shp
 
Upvote 0
Solution

Forum statistics

Threads
1,215,071
Messages
6,122,964
Members
449,094
Latest member
Anshu121

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