giaiphap
==(^o^)==
Bạn sửa code của bạn chổ màu đỏ là được.Cảm ơn bác đã chia sẻ một bài rất hữu ích. Em đã xem và học hỏi áp dụng cho công việc của mình nhưng mãi mà không cho hiện hình lên được. Bác kiểm tra giúp xem em sai ở chỗ nào hay thiếu sót ở đâu thì sửa giúp em và chỉ dẫn luôn để em học hỏi thêm. Công việc là cho hiện ảnh lên ở sheet 1 khi nhập mã sô lấy từ sheet 2. Ở đây em có 5 hình làm ví dụ khi em có 200 hình thì có tương tự không? Em cảm ơn trước ạ.
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Picname As String
Application.ScreenUpdating = False
On Error Resume Next
If Not Intersect([F4], Target) Is Nothing Then
Set Rng = Sheets(2).Range(Sheets(2).[F7], Sheets(2).[F1000].End(xlUp))
Picname = ThisWorkbook.Path & "\Anhthohan\" & [COLOR=#ff0000][B]Rng.Find(Target, , xlValues, xlWhole, , , True).Offset(, -5)[/B][/COLOR]
'Xoa anh da chon o lan truoc di
Sheets(1).Shapes([D6].Address).Delete
'Dinh kich thuoc anh
[D6].Select
With ActiveSheet.Pictures.Insert(Picname)
'.Name = Target.Offset(1, 0).Address
.Name = [D6].Address
'.Left = Target.Offset(1, 0).Left: Top = Target.Offset(1, 0).Top
.Left = [D6].Left: Top = [D6].Top
.Width = 310 '(pixcels) <-- dieu chinh be rong
.Height = 315 '(pixcels) <-- dieu chinh chieu cao
End With
'Di chuyen hinh vao trong khung:
ActiveSheet.Shapes("$D$6").IncrementTop 2#
ActiveSheet.Shapes("$D$6").IncrementLeft 2.5
End If
Application.ScreenUpdating = True
End Sub