Xin trợ giúp code VBA Excel không hoạt động ạh ?

[wangxiquang123]

Chào mọi người, mình có một đoạn code chèn hình ảnh tự động vào excel, nhưng không hoạt động được. Mong mọi người giúp đỡ có gì sai không ạh ? Cảm ơn mọi người !

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, PicName As String, PicName2 As String, PicName3 As String, PicName4 As String
Application.ScreenUpdating = False
On Error Resume Next
If Not Intersect([E8], Target) Is Nothing Then
Set Rng = Sheet3.Range(Sheet3.[A1], Sheet3.[P65536].End(xlUp))
PicName = Rng.Resize(, 1).Find(Target, LookAt:=xlWhole).Offset(, 11)
PicName2 = Rng.Resize(, 1).Find(Target, LookAt:=xlWhole).Offset(, 12)
PicName3 = Rng.Resize(, 1).Find(Target, LookAt:=xlWhole).Offset(, 13)
PicName4 = Rng.Resize(, 1).Find(Target, LookAt:=xlWhole).Offset(, 14)
PicName5 = Rng.Resize(, 1).Find(Target, LookAt:=xlWhole).Offset(, 15)
PicName6 = Rng.Resize(, 1).Find(Target, LookAt:=xlWhole).Offset(, 16)
ActiveSheet.Shapes("aPic").Delete
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & PicName)
.Name = "aPic"
.Left = [A108:I122].Left: .Top = [A108:I122].Top
.Width = [A108:I122].Width: .Height = [A108:I122].Height
End With
ActiveSheet.Shapes("bPic").Delete
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & PicName2)
.Name = "bPic"
.Left = [F108:I122].Left: .Top = [F108:I122].Top
.Width = [F108:I122].Width: .Height = [F108:I122].Height
End With
ActiveSheet.Shapes("cPic").Delete
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & PicName3)
.Name = "cPic"
.Left = [A125:I139].Left: .Top = [A125:I139].Top
.Width = [A125:I139].Width: .Height = [A125:I139].Height
End With
ActiveSheet.Shapes("dPic").Delete
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & PicName4)
.Name = "dPic"
.Left = [F125:I139].Left: .Top = [F125:I139].Top
.Width = [F125:I139].Width: .Height = [F125:I139].Height
End With
ActiveSheet.Shapes("ePic").Delete
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & PicName5)
.Name = "ePic"
.Left = [A142:I156].Left: .Top = [A142:I156].Top
.Width = [A142:I156].Width: .Height = [A142:I156].Height
End With
ActiveSheet.Shapes("fPic").Delete
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & PicName6)
.Name = "fPic"
.Left = [F142:I156].Left: .Top = [F142:I156].Top
.Width = [F142:I156].Width: .Height = [F142:I156].Height
End With
End If
End Sub