Macro tạo Catalog với Excel từ hình ảnh trong máy

 Ứng dụng:Phù hợp với TD, Sales ,..những tác vụ yêu cầu file Excel có chèn hình. 

Tips:Nếu bạn cảm thấy khó khăn trong việc lấy địa chỉ hình ảnh, tham khảo bài viết :

SUB lấy địa chỉ của file Hình ảnh

Nguồn:Sưu tầm tại công ty nội thất

Bước 1:Chuẩn bị 1 template với 1 cột có chiều rộng dài phù hợp với kích thước hình bạn muốn hiển thị.

(Ví dụ trong sub dưới là cột P)

Sub Chenhinh()

Dim myPict As Picture

Dim curWks As Worksheet

Dim myRng As Range

Dim myCell As Range

Dim myPictName As Variant

Set curWks = Sheets(1)   ' Change to suit

curWks.Pictures.Delete

With curWks

    Set myRng = .Range("M2", .Cells(.Rows.Count, "M").End(xlUp))

End With

=>M ở đây là cột chứa địa chỉ của hình

For Each myCell In myRng.Cells

    If Trim(myCell.Value) = "" Then

        'do nothing

    ElseIf Dir(CStr(myCell.Value)) = "" Then

        'picture not there!

    Else

        With myCell.Offset(0, 3) 

'Chỉ định cột sẽ chèn hình là cột thứ 3 về phía tay phải của cột M, tức là cột P

            Set myPict = myCell.Parent.Pictures.Insert(myCell.Value)

            myPict.Top = .Top + 2

            myPict.Width = .Width - 4

            myPict.Height = .Height - 4

            myPict.Left = .Left + (.Width - myPict.Width) / 2

'=>resize hình

            myPict.Placement = xlMoveAndSize

        End With

    End If

Next myCell

End Sub