Help! Cải tiến code VBA chèn hình vào file Excel

[zukura]

Cả nhà giúp em với.

Vấn đề của em là khi có 1 cột mã hàng, thì excel sẽ tự chèn ảnh có sẵn (trong thư mục cố định, tên file là tên của mã hàng) vào cột bên cạnh.

Trước đó em có xài cách của 1 bác khác là viết 1 hàm riêng cho file excel đó, hàm compic(đường dẫn hình). Là dạng chèn hình vào comment. Nhưng do lúc chạy rất hay bị văng ra nên không được tiện lắm.

Hôm qua em mò trên mạng được code VBA của 1 bác về chèn hình vào excel sau khi ta gõ mã của hình đó.
Thấy code của bác này chạy rất nhẹ nhàng và chèn trực tiếp (chứ không phải comment), nên em rất thích.
Nhưng chưa đủ áp dụng vào công việc của em, nhờ các bác cao thủ giúp em với ạ:
- File đính kèm đã có code chạy cho cột mã 1
- Nếu em có thêm cột mã 2 thì code sẽ viết như thế nào? (Nếu dạng hàm thì quá dễ, hàm ở đâu hình sẽ hiện ở đó)
- Cột mã nếu là công thức hoặc khi copy dán thì code không chạy (cả ngàn mã không thể gõ tay rồi enter được) -> lỗi type miss match
- Nếu trong 10 mã mà có 5 mã bị sai, bỏ trống -> 5 mã còn lại vẫn hiện hình, 5 mã kia không hiện (đằng này báo lỗi và ko hiện tất)

Giúp em với nha.

 

[batman1]

Em chào các bác, các bác cho em hỏi nếu muốn vùng chọn hiện ảnh là nhiều cell thì mã code viết như nào ạ. Ví dụ em muốn gộp ô nhập mã là từ N17:N25 và ô chèn ảnh là O17:O25, tương tự gộp như vậy cho các cell dưới cột N và chèn ảnh cột O. Em chưa thạo mong các bác giúp đỡ ạ!!!

Bạn không đọc kỹ rồi. Tôi là người viết rất có tâm

Sub InsertPicture(ByVal PicFilename As String, Optional Target As range = Nothing, _
Optional original As Boolean = False, Optional center As Boolean = False, _
Optional LinkToFile As Boolean = False)
' Target: vung nhap anh. Co the la nhieu cell
' Neu Target = Nothing thi Target = ActiveCell
' Neu original = True thi nhap anh kich thuoc thuc.
' Neu original = FALSE thi neu center = True thi anh se center trong vung Target,
' nguoc lai thi se vua khit vung Target
' LinkToFile = False thi khong can giu anh tren dia, nguoc lai bat buoc phai giu anh de moi lan mo thi co

Rõ ràng có: Target: vung nhap anh. Co the la nhieu cell. Và không có một chỗ nào tôi viết là Target phải MERGE CELLS, bạn tự hiểu. Không phải tức có thể, cho phép, nhưng không bắt buộc.

Nếu MÃ ở N17 cũng là tên ảnh thì Range("N17").Value, tức tên ảnh, phải nối với đường dẫn tới thư mục ảnh và định dạng của ảnh (PNG, JPG, BMP, ...) để có đường dẫn đầy đủ nhập vào PicFilename. Đọc bài có

ThisWorkbook.path & "\" & rng.Value & ".jpg"

mà không biết bắt chước thì bó tay.

Nếu vùng chèn ảnh là O17:O25 thì nhập Range("O17:O25") với tư cách là TARGET. Thế thôi.

Mà nếu không biết tường tận thì cũng phải bỏ công ra viết, dù có sai, đính kèm tập tin. Lúc đó người khác sẽ sửa. Còn ngồi rung đùi muốn người khác làm từ A đến Z thì hơi ... Thôi thì cho là hơi không phải.

 

[Minh Giáp]

Bạn không đọc kỹ rồi. Tôi là người viết rất có tâm



Rõ ràng có: Target: vung nhap anh. Co the la nhieu cell. Và không có một chỗ nào tôi viết là Target phải MERGE CELLS, bạn tự hiểu. Không phải tức có thể, cho phép, nhưng không bắt buộc.

Nếu MÃ ở N17 cũng là tên ảnh thì Range("N17").Value, tức tên ảnh, phải nối với đường dẫn tới thư mục ảnh và định dạng của ảnh (PNG, JPG, BMP, ...) để có đường dẫn đầy đủ nhập vào PicFilename. Đọc bài có

ThisWorkbook.path & "\" & rng.Value & ".jpg"

mà không biết bắt chước thì bó tay.

Nếu vùng chèn ảnh là O17:O25 thì nhập Range("O17:O25") với tư cách là TARGET. Thế thôi.

Mà nếu không biết tường tận thì cũng phải bỏ công ra viết, dù có sai, đính kèm tập tin. Lúc đó người khác sẽ sửa. Còn ngồi rung đùi muốn người khác làm từ A đến Z thì hơi ... Thôi thì cho là hơi không phải.

Dạ em cảm ơn bác đã chỉ rất tận tình ạ, vì rằng em mới biết đến code nên chưa hiểu để viết mà đang cần dùng mong bác thông cảm. Chúc bác thật nhiều sức khỏe ạ

 

[trinhduyvu]

Sub InsertPicture(ByVal PicFilename As String, Optional Target As range = Nothing, _
                Optional original As Boolean = False, Optional center As Boolean = False, _
                Optional LinkToFile As Boolean = False)
'    Target: vung nhap anh. Co the la nhieu cell
'    Neu Target = Nothing thi Target = ActiveCell
'    Neu original = True thi nhap anh kich thuoc thuc.
'    Neu original = FALSE thi neu center = True thi anh se center trong vung Target,
'    nguoc lai thi se vua khit vung Target
'    LinkToFile = False thi khong can giu anh tren dia, nguoc lai bat buoc phai giu anh de moi lan mo thi co
Dim w As Double, h As Double, shp As Shape, fso As Object
    If Target Is Nothing Then Set Target = ActiveCell
    On Error Resume Next
    Target.Parent.Shapes(Target.Address).Delete
    On Error GoTo 0
 
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    If fso.FileExists(PicFilename) Then
        If LinkToFile Then
            Set shp = Target.Parent.Shapes.AddPicture(PicFilename, msoTrue, msoFalse, Target.left, Target.top, 0, 0)
        Else
            Set shp = Target.Parent.Shapes.AddPicture(PicFilename, msoFalse, msoTrue, Target.left, Target.top, 0, 0)
        End If
        If Not shp Is Nothing Then
            With shp
                If original Then
                    .ScaleWidth 1, msoTrue
                    .ScaleHeight 1, msoTrue
                ElseIf center Then
                    .ScaleWidth 1, msoTrue
                    .ScaleHeight 1, msoTrue
                    w = Target.Width
                    h = w * .Height / .Width
                    If h > Target.Height Then
                        h = Target.Height
                        w = h * .Width / .Height
                    End If
                    .left = Target.left + (Target.Width - w) / 2
                    .top = Target.top + (Target.Height - h) / 2
                    .Width = w
                    .Height = h
                Else
                    .Width = Target.Width
                    .Height = Target.Height
                End If
                shp.Name = Target.Address
                shp.Placement = xlMoveAndSize
            End With
        End If
    End If
  
     Set fso = Nothing
End Sub

Đoạn code này của bác batman1 hay quá, tôi áp dụng vào file của mình được. Nhưng tôi không đủ giỏi để hiểu hết đoạn code này, không biết có thể sửa như thế nào để ảnh mình chèn hiển thị dưới dạng icon, nhấn vào thì ảnh mới mở lên, chứ không hiển thị trực tiếp như hiện tại được không.