Excel Macro VBA - 检查图像是否在单元格中答案

【问题标题】：Excel Macro VBA - Check if Image is in CellExcel Macro VBA - 检查图像是否在单元格中
【发布时间】：2018-07-04 10:33:29
【问题描述】：

我有一个宏，可以在单击单元格时在单元格中插入图像。

当您点击已经有图像的那个时，宏会重复，并且单元格中有 2 个图像。

但我想限制它。当单元格中已经有一个图像时，宏应该什么都不做。

如何实现？

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 20 Then
        Call Makro1
    End If
End Sub


Sub Makro1()
    On Error GoTo Ende

    Application.Cursor = xlWait
    ActiveSheet.Pictures.Insert( _
    ThisWorkbook.Path & "\Fotos\" & Range("A" & ActiveCell.Row).Value & ".jpg" _
      ).Select
    Selection.ShapeRange.ScaleWidth 0.28, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.28, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.IncrementLeft 4
    Selection.ShapeRange.IncrementTop 4
    Selection.Placement = xlMoveAndSize
    ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:= _
      "Fotos\" & Range("A" & ActiveCell.Row).Value & ".jpg"
    Range("A1").Select
    Application.Cursor = xlDefault

Ende:
    Application.Cursor = xlDefault
End Sub

【问题讨论】：

标签： vba image excel detect

【解决方案1】：

这是我的答案的代码。 :)

Function isImageInRange(Target As Range) As Boolean
    Dim pic As Picture
    Dim PictureRanges As Range

    With Target.Parent
        For Each pic In .Pictures
            With Range(pic.TopLeftCell, pic.BottomRightCell)
                If PictureRanges Is Nothing Then
                    Set PictureRanges = .Cells
                Else
                    Set PictureRanges = Union(PictureRanges, .Cells)
                End If
            End With
        Next
    End With

    If Not PictureRanges Is Nothing Then isImageInRange = Not Intersect(Target, PictureRanges) Is Nothing

End Function

【讨论】：