Giúp tạo addin cho đoạn code sau (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

ungphong

Thành viên mới
Tham gia
1/10/08
Bài viết
1
Được thích
0
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.

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
 
Cái vụ này thì chỉ có dán code trực tiếp trên sheet thôi, chứ add-ins không xài được.
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom