[Hỏi VBA] Chèn hình ảnh tự động vào Excel bằng VBA

Option Explicit
Function CommPic(Pic As String, Cel As Range) As String
  On Error Resume Next
  Application.Volatile
  Cel.Comment.Delete
  If Cel.Comment Is Nothing Then Cel.AddComment
  Cel.Comment.Text vbLf
  With Cel.Comment.Shape
    .Left = Cel.Left: .Top = Cel.Top: .Visible = True
    .Width = Cel.Width: .Height = Cel.Height
    .Fill.UserPicture Pic
  End With
End Function

Function CommPic(Cell1 As Range, Cell2 As Range) As String
  On Error Resume Next
  Application.Volatile
  Cell2.Comment.Delete
  If Cell2.Comment Is Nothing Then Cell2.AddComment
  Cell2.Comment.Text vbLf
  With Cell2.Comment.Shape
    .Left = Cell2.Left: .Top = Cell2.Top: .Visible = True
    .Width = Cell2.Width: .Height = Cell2.Height
    .Fill.UserPicture ThisWorkbook.Path & "\Pic" & Cell1.Value & ".jpg"
  End With
End Function

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim Shp As Shape
    Dim rngZ As Range
    If Target.Row <> 1 And Target.Column <> 1 Then Exit Sub
    'Bay loi Su kien
    Application.EnableEvents = False
    'Xoa cac Shape dang ton tai tren sheet
    For Each Shp In ActiveSheet.Shapes
        Shp.Delete
    Next
    Range("D4").Select
    'Bat dau chen hinh anh
    Do Until ActiveCell.Offset(0, -3).FormulaR1C1 = vbNullString
        ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\Pic" & ActiveCell.Offset(0, -3).Value & ".jpg").Select
        With Selection
            Set rngZ = .TopLeftCell
            .ShapeRange.ScaleHeight rngZ.Height / .Height, msoFalse
            .ShapeRange.ScaleWidth rngZ.Width / .Width, msoFalse
            .PrintObject = True
        End With
        rngZ.Offset(1, 0).Select
    Loop
    Application.EnableEvents = True
End Sub