[英]Excel Macro VBA - Check if Image is in Cell
我有一个宏,可在单击单元格时在单元格中插入图像。
当您单击已有图像的时,宏会重复,并且单元格中有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
这是我的答案的代码。 :)
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.