Excel - VBA - Функция обнаружения изображения в ячейке

Question

Я хотел написать функцию, которая определяет, есть ли изображение в ячейке. Когда нет, он переходит к следующему ряду. Столбец остается прежним.

Моя функция не работает.

Public Function HasImage(ByVal Target As Range) As Boolean
Dim bResult As Boolean
Dim shp As Shape
     bResult = False
         For Each shp In ActiveSheet.Shapes
             If shp.TopLeftCell.Address = Target.Address _
                     And shp.BottomRightCell.Address = Target.Address Then
                 bResult = True
             End If
         Next shp
     HasImage = bResult
 End Function

Answer 1

Возможно, я ошибаюсь, но нужно ли смещать BottomRightCell (1,1) от верхнего края при размере изображения в одну ячейку?

В моем тестировании ваш код, похоже, не сработал из-за BottomRightCell.Address, с размером изображения в одну ячейку, строкой ниже и столбцом справа.

Я протестировал с помощью следующего кода, где я настроил BottomRightCell.Addres с:

And shp.BottomRightCell.Address = Target.Offset(1, 1).Address 

Код:

Option Explicit

Public Sub test()
    Dim mypic As Object

    Set mypic = ActiveSheet.Pictures(1)
    PositionPic mypic
    MsgBox HasImage([A1])
    MsgBox mypic.BottomRightCell.Address

End Sub

Public Function HasImage(ByVal Target As Range) As Boolean
    Dim bResult As Boolean
    Dim shp As Shape
    bResult = False
    For Each shp In ActiveSheet.Shapes
        If shp.TopLeftCell.Address = Target.Address _
           And shp.BottomRightCell.Address = Target.Offset(1, 1).Address Then
            bResult = True
        End If
    Next shp
    HasImage = bResult
End Function

Public Sub PositionPic(ByVal mypic As Object)
    With mypic
        .Left = ActiveSheet.Cells(1, 1).Left
        .Top = ActiveSheet.Cells(1, 1).Top
        .Width = ActiveSheet.Cells(1, 1).Width
        .Height = ActiveSheet.Cells(1, 1).Height
    End With
End Sub