简体   繁体   中英

Check if exists an image in a range of cells in Excel VBA

I have a excel file in which I want check if exists an image in a range of cells.

I've been trying with the following code:

Sub findImage(Cell As Range)
   Dim Caddress As String
   Dim Pict As Excel.Picture
   Application.Volatile
   Sheets("Sheet1").Select
   Caddress = Cell.Address 'Assign the range
   For Each Pict In ActiveSheet.Pictures 'Check for each picture in the range
      If Pict.TopLeftCell.Address = Caddress Then 'if exists in the range shows a message
        MsgBox "The image exists!"
         Exit For 'break for
         Exit Sub 'break sub
      End If
   Next Pict
   MsgBox "NO", vbInformation 'if not exists shows a message
End Sub

This code doesn't works, this shows an error "not compatible types Err. 13".

Any question post on comments.

I tweaked the code a little (removed the .Select line) and added haveImage boolean value, to make the code a little more logical. I also changed Cell to Cel , as I've found using Cell can get confused with Cells .

Sub findImage(Cel As Range)
Dim Caddress As String
Dim shp    As Shape
Dim haveImage As Boolean

haveImage = False

Application.Volatile
' Sheets("Sheet1").Activate
Caddress = Cel.Address      'Assign the range
For Each shp In Sheets("Sheet1").Shapes    'Check for each picture in the range
    If shp.Type = msoPicture Then
        If shp.TopLeftCell.Address = Caddress Then    'if exists in the range shows a message
            haveImage = True
            Exit Sub             'break sub
        End If
    End If
Next shp

If haveImage Then
    Exit Sub
Else
    MsgBox "NO", vbInformation    'if not exists shows a message
End If
End Sub

To use this, you would call it like this: Call findimage(Sheets("Sheet1").Range("C12"))

Note: If the cell has a picture that does not have the top-left corner of that picture, in the cell, it's going to return "No".

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM