Excel VBA -在Worksheet_Change事件中将图像插入工作表时出现问题
Excel VBA -在Worksheet_Change事件中将图像插入工作表时出现问题
提问于 2016-11-22 17:01:31
我有两个专栏：
A B
1 Animal Picture
2 Lion (Lion picture)
3 Ant (Ant picture)当我删除该A2值时，只有最新的图片会被删除。我必须再次删除空单元格A2来删除单元格B2中的剩余图片。
有没有办法解决这个问题？
以下是我当前的Worksheet_Change事件代码：
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo son
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
If Target.Row Mod 20 = 0 Then Exit Sub
If Not IsEmpty(Target) Then '<--| if changed cell content is not empty
With Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".png")
.Top = Target.Offset(0, 2).Top
.Left = Target.Offset(0, 1).Left
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = Target.Offset(0, 2).Height
.ShapeRange.Width = Target.Offset(0, 2).Width
.Name = Target.Address '<--| associate the picture to the edited cell via its address
End With
Else '<--| if cell content has been deleted
Me.Shapes(Target.Address).Delete '<--| delete the picture whose name is associated to the cell via its address
End If
Target.Offset(1, 0).Select
son:
End Sub回答 1
Stack Overflow用户
发布于 2016-11-22 19:38:54
我同意@RCaetano的评论：
...maybe您应该始终(并且在执行任何操作之前)删除与您正在编辑的单元格相关的图片。
如果你遵循这个建议，那么你就不会面临图像重叠的问题。如果A2包含“Lion”；您手动编辑单元格并重新输入“Lion”，那么您将面临删除和重新插入相同图像的小开销-但这是一个比您当前拥有的更好的结果。
Worksheet_Change代码可以是：
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo son
Application.ScreenUpdating = False
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
If Target.Row Mod 20 = 0 Then Exit Sub
'remove the picture
Dim shp As Shape
For Each shp In Me.Shapes
If shp.Name = Target.Address Then
Me.Shapes(Target.Address).Delete
Exit For
End If
Next
'add a picture of the text that was entered
If Not IsEmpty(Target) Then '<--| if changed cell content is not empty
With Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".png")
.Top = Target.Offset(0, 2).Top
.Left = Target.Offset(0, 1).Left
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = Target.Offset(0, 2).Height
.ShapeRange.Width = Target.Offset(0, 2).Width
.Name = Target.Address '<--| associate the picture to the edited cell via its address
End With
End If
Target.Offset(1, 0).Select
Application.ScreenUpdating = True
son:
Application.ScreenUpdating = True
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/40737579
复制相关文章
相似问题
腾讯云开发者
