Question

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

当点击已具有图像的时，宏会重复，并且单元格中有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

Answer 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

Excel宏VBA-检查图像是否在单元格中

1 个答案: