VBA : Check If A Cell Contains Picture in Multiple Sheets

[muhammad susanto]

hi all..

i have over 50 sheets in single workbook, for each sheet should be contained picture in e.g cell H10.
my problem is to make sure how to check if in cell H10 for multiple sheets contains the picture.
if in cell H10 contains picture <code class="vb plain" style="font-size: 16px; white-space: nowrap; padding: 0px !important; font-family: Consolas, "Bitstream Vera Sans Mono", "Courier New", Courier, monospace !important; color: rgb(0, 0, 0) !important; border-radius: 0px !important; background: none !important; border: 0px !important; bottom: auto !important; float: none !important; height: auto !important; left: auto !important; line-height: 1.1em !important; margin: 0px !important; outline: 0px !important; overflow: visible !important; position: static !important; right: auto !important; top: auto !important; vertical-align: baseline !important; width: auto !important; box-sizing: content-box !important; min-height: auto !important;">MsgBox </code><code class="vb string" style="font-size: 16px; white-space: nowrap; padding: 0px !important; font-family: Consolas, "Bitstream Vera Sans Mono", "Courier New", Courier, monospace !important; color: rgb(0, 0, 255) !important; border-radius: 0px !important; background: none !important; border: 0px !important; bottom: auto !important; float: none !important; height: auto !important; left: auto !important; line-height: 1.1em !important; margin: 0px !important; outline: 0px !important; overflow: visible !important; position: static !important; right: auto !important; top: auto !important; vertical-align: baseline !important; width: auto !important; box-sizing: content-box !important; min-height: auto !important;">"Image exists!"</code> if the otherwise <code class="vb plain" style="font-size: 16px; white-space: nowrap; padding: 0px !important; font-family: Consolas, "Bitstream Vera Sans Mono", "Courier New", Courier, monospace !important; color: rgb(0, 0, 0) !important; border-radius: 0px !important; background: none !important; border: 0px !important; bottom: auto !important; float: none !important; height: auto !important; left: auto !important; line-height: 1.1em !important; margin: 0px !important; outline: 0px !important; overflow: visible !important; position: static !important; right: auto !important; top: auto !important; vertical-align: baseline !important; width: auto !important; box-sizing: content-box !important; min-height: auto !important;">MsgBox </code><code class="vb string" style="font-size: 16px; white-space: nowrap; padding: 0px !important; font-family: Consolas, "Bitstream Vera Sans Mono", "Courier New", Courier, monospace !important; color: rgb(0, 0, 255) !important; border-radius: 0px !important; background: none !important; border: 0px !important; bottom: auto !important; float: none !important; height: auto !important; left: auto !important; line-height: 1.1em !important; margin: 0px !important; outline: 0px !important; overflow: visible !important; position: static !important; right: auto !important; top: auto !important; vertical-align: baseline !important; width: auto !important; box-sizing: content-box !important; min-height: auto !important;">"Image does not exists, please see in Sheet...., Sheet..., Sheet.."
</code>
the macro work in multiple sheets not only 1 sheet..

anybody help me, greatly appreciated...

.sst

 

[MickG]

Give this a try:-
The code assumes that the "Picture" top left corner should be in "H10", to qualify.

[COLOR="Navy"]Sub[/COLOR] MG25Aug39
[COLOR="Navy"]Dim[/COLOR] pic [COLOR="Navy"]As[/COLOR] Shape, Sht [COLOR="Navy"]As[/COLOR] Worksheet, nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Sht [COLOR="Navy"]In[/COLOR] Worksheets
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] pic [COLOR="Navy"]In[/COLOR] Sht.Shapes
   [COLOR="Navy"]If[/COLOR] pic.Type = msoPicture [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] pic.TopLeftCell.Address(0, 0) = "H10" [COLOR="Navy"]Then[/COLOR]
            nStr = nStr & IIf(nStr = "", Sht.Name, vbLf & Sht.Name)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] pic
[COLOR="Navy"]Next[/COLOR] Sht
[COLOR="Navy"]If[/COLOR] nStr <> "" [COLOR="Navy"]Then[/COLOR]
    MsgBox "Images found in :- " & vbLf & nStr
[COLOR="Navy"]Else[/COLOR]
   MsgBox "No Images Found"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[muhammad susanto]

hi Mick...
sorry i missing it...
actually for main target is IMAGE NOT FOUND...how to reverse it..
i think my title is CHECK IF A CELL NOT CONTAINS PICTURE

 

[MickG]

Sorry , Try this:-

[COLOR="Navy"]Sub[/COLOR] MG25Aug48
[COLOR="Navy"]Dim[/COLOR] pic [COLOR="Navy"]As[/COLOR] Shape, Sht [COLOR="Navy"]As[/COLOR] Worksheet, nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Fd [COLOR="Navy"]As[/COLOR] Boolean
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Sht [COLOR="Navy"]In[/COLOR] Worksheets
Fd = False
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] pic [COLOR="Navy"]In[/COLOR] Sht.Shapes
   
   [COLOR="Navy"]If[/COLOR] pic.Type = msoPicture [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] pic.TopLeftCell.Address(0, 0) = "H10" [COLOR="Navy"]Then[/COLOR]
           Fd = True
        [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] pic
[COLOR="Navy"]If[/COLOR] Not Fd [COLOR="Navy"]Then[/COLOR]
    nStr = nStr & IIf(nStr = "", Sht.Name, vbLf & Sht.Name)
    c = c + 1
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Sht

[COLOR="Navy"]If[/COLOR] c = 0 [COLOR="Navy"]Then[/COLOR]
    MsgBox "Images found in all sheets"
[COLOR="Navy"]Else[/COLOR]
    MsgBox "Images NOT found in :- " & vbLf & nStr
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[muhammad susanto]

hi Mick...i don't know what happened.
if i use the real picture i mean the picture name is picture 1, picture 2, your code is work., but if the picture not real name your code is not working...
i attachment this link file...

https://app.box.com/s/k2h0lubo9lqthf5ncmtt8a2rd6h3a1ns

note : the sheet3 not contains picture...

 

[MickG]

Try changes Code line beow:-

From this:-

If pic.Type = msoPicture Then

To this:-

If pic.Type = 11 Then

 

[muhammad susanto]

hi Mick..why still not work. i attachment the other my sample case...
please...

https://app.box.com/s/oek1imb7oc7cya6ac2snyw75vj0vx7qd

 

[Fluff]

Mick's original code works for the new file.

 

[muhammad susanto]

thanks but i have tested with my new file attachment pos #7

 

[MickG]

Try changing the same line to :-

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