Reputation:
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
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