user9907666
user9907666

Reputation:

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

Upvotes: 0

Views: 1926

Answers (1)

TinMan
TinMan

Reputation: 7759

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

Upvotes: 1

Related Questions