Chèn Hình Ảnh Tự Động vào Excel bằng VBA

- Để chèn hình ảnh vào trong excel các bạn chuẩn bị 1 thư mục chứa các hình ảnh cần thiết, và 1 file excel cần chèn hình ảnh, sau đó xem video bên dưới để thực hiện.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:A]) Is Nothing Or Target.Row = 1 Then Exit Sub
On Error GoTo Err_
Target(, 2).Worksheet.Shapes(Target.Address).Delete
Err_:
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Target.Value & ".jpg")
    .Name = Target.Address
    .Top = Target.Top
    .Left = Target(, 2).Left
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Height = Target.Height
    .ShapeRange.Width = Target(, 2).Width
End With
Target.Offset(1, 0).Select
End Sub

Nếu Các bạn muốn copy một hình có sẵn trên sheet khác thì có thể copy code bên dưới nhé, và xem video mình họa, ở đây sheet dữ liệu là sheet2, nếu các bạn đặt ở sheet khác thì có thế thay đổi cho phù hợp

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:A]) Is Nothing Or Target.Row = 1 Then Exit Sub
On Error Resume Next
Target(, 2).Worksheet.Shapes(Target.Address).Delete
On Error GoTo Thoat
With Sheet2
    .Shapes(.Range("data").Find(Target.Value, , xlValues, xlWhole).Value).CopyPicture
End With
ActiveSheet.PasteSpecial
With Selection
    .Name = Target.Address
    .Top = Target.Top
    .Left = Target(, 2).Left
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Height = Target.Height
    .ShapeRange.Width = Target(, 2).Width
End With
Thoat:
Target.Offset(1, 0).Select
End Sub