Mọi người trên forum giúp mình tạo cái addin cho đoạn code này đi. Mình để đoạn code nay trong từng sheet thì nó chạy rất ổn định, nhưng do làm phải làm nhiều file excel khác nhau, mà mỗi lần làm là phải copy đoạn code này paste vào phần VB của từng sheet thì phiền lắm vì có một vài người không biết làm. Nên mình muốn tạo thành một cái addin hoặc Macro để chèn vào trong excel luôn. Không biết là có làm được không. Mong mọi người giúp mình với.
Xin cám ơn.
Mô tả đoạn code:
Đoạn code này dùng để chèn hình tự động vào ô A5 tới A5000 khi người dùng nhập tên của hình vào.
Xin cám ơn.
Mô tả đoạn code:
Đoạn code này dùng để chèn hình tự động vào ô A5 tới A5000 khi người dùng nhập tên của hình vào.
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim PicRng As Range, Pos As String
Application.ScreenUpdating = False
On Error Resume Next
If Not Intersect([b5:b5000], Target) Is Nothing Then
Set PicRng = Range("G1").CurrentRegion '<--- Dat ten cho vung tra cuu hinh
Pos = "Z:\Noi Dia\Hinh TBSP\" & Target & ".jpg"
Pos = WorksheetFunction.VLookup(Target, PicRng, 2, 0) '<--- Xac dinh vi trí chua file hinh tren PC
ActiveSheet.Shapes(Target.Address).Delete '<--- Xoa hinh da dat ten truoc do
With ActiveSheet.Pictures.Insert(Pos) '<--- Chen hinh moi
.Name = Target.Address '<--- Dat ten cho hinh moi
.Left = Target(1, 2).Left + 15: .Top = Target(1, 0).Top + 2 '<--- Dinh vi cho hinh
.Width = [C12:C12].Width - 4
.Height = [C12:C12].Height - 4
End With
End If
Application.ScreenUpdating = True
End Sub