Изменение листа триггера VBA с копированием / вставкой - PullRequest
1 голос
/ 03 апреля 2020

Я пытаюсь использовать VBA для заполнения столбца электронной таблицы G файлом изображения на основе значения столбца B в той же строке листа. Если я вручную ввожу значение в столбец 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

1 Ответ

0 голосов
/ 03 апреля 2020

Когда вы вставляете несколько значений, параметр Target становится массивом вставляемого диапазона. И это также массив из 1 члена, если вы вставляете только 1 строку.

Итак, используйте For..Next l oop, чтобы завершить всю вставленную вами строку. И измените все 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...