VBA触发器工作表随复制/粘贴而更改

Question

我正在尝试使用VBA，根据工作表同一行上B列的值，用图像文件填充电子表格G列。如果我手动将值输入B列，一切都会很好，但我有一个长列表，希望将多个值复制/粘贴到B列。当我粘贴时，似乎没有触发工作表更改，H列也没有填充图像。我正在使用的代码如下，如有任何帮助，我们将不胜感激。谢谢

Private Sub Worksheet_Change(ByVal Target As Range)
Dim shp As Shape
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
If Target.Row Mod 20 = 0 Then Exit Sub
On Error GoTo son
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture And shp.TopLeftCell.Address = Target.Offset(0, 4).Address Then shp.Delete
Next
If Target.Value <> "" And Dir(ThisWorkbook.Path & "" & Target.Value & ".jpg") = "" Then
'picture not there!
MsgBox Target.Value & " Doesn't exist!"
End If
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "" & Target.Value & ".jpg").Select
Selection.Top = Target.Offset(0, 5).Top
Selection.Left = Target.Offset(0, 5).Left
With Selection.ShapeRange
.LockAspectRatio = msoFalse
.Height = Target.Offset(0, 5).Height
.Width = Target.Offset(0, 5).Width
End With
Target.Offset(1, 0).Select
son:
End Sub

Answer 1

粘贴多个值时，Target参数将成为粘贴范围的数组。如果只粘贴一行，它也是一个由1个成员组成的数组。

因此，使用For..Next循环来完成粘贴的所有行。并将所有Target更改为Target(i)，并更改一些代码，如下所示。

For i = 1 To Target.Rows.Count
If Target(i).Value <> "" And Dir(ThisWorkbook.Path & "" & Target(i).Value & ".jpg") = "" Then
'picture not there!
MsgBox Target(i).Value & " Doesn't exist!"
Else
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "" & Target(i).Value & ".jpg").Select
Selection.Top = Target(i).Offset(0, 5).Top
Selection.Left = Target(i).Offset(0, 5).Left
With Selection.ShapeRange
.LockAspectRatio = msoFalse
.Height = Target(i).Offset(0, 5).Height
.Width = Target(i).Offset(0, 5).Width
End With
End If
Next