简体   繁体   中英

Excel Macro VBA - Check if Image is in Cell

I have a macro that inserts image in a cell when clicking on the cell.

When you click on the which already has an image, the macro repeats and there are 2 Images in the cell.

But I want to limit it. When there is already an Image in the cell, the Macro should do nothing.

How to achieve it?


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

Here is the code for my Answer. :)

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

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