时间戳

首页 > 解决方案 > VBA 触发工作表更改与复制/粘贴

excel - VBA 触发工作表更改与复制/粘贴

问题描述

我正在尝试使用 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

标签： excelvba

解决方案

当您粘贴多个值时，Target参数变为您粘贴的范围数组。如果仅粘贴 1 行，它也是 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

推荐阅读