Macro tạo Catalog Excel với hình ảnh từ URL

Tại sao có bài viết  này:Hiện tại việc quản lý sản phẩm bằng dịch vụ của bên thứ ba thông qua website rất phổ biến, mỗi tài nguyên dạnh hình ảnh, video, file 3D ...khi tải lên sẽ được định danh bằng 1 URL.

Khi user muốn tạo 1 catalog bằng Excel với hình ảnh kèm theo, URL của ảnh được đặt ở cột A và hình ảnh cũng sẽ được đặt ở gọn trong ô của cột A(Cột A đã được Format chiều dài-rộng phù hợp), cột B-C-D-E...sẽ là các thông tin khác của sản phẩm. Bạn sẽ không muốn down hình về, insert từng tấm vào ô rồi ngồi kéo kích thước từng tấm đúng không?

Các bước làm:

1. Chuẩn bị 1 Template đẹp, các bạn sẽ không muốn chỉnh sửa chiều rộng-dài sau khi đã insert hình vào đâu.

2.Cột A là nơi chưa URL của hình, SỐ dòng chứa thông tin ở cột B bắt buộc bằng cột A, bạn có thể để cột B là ID, tên sản phẩm, số thứ tự,...

3. Chạy sub này, lưu ý, nếu bạn chạy 2 lần, hình sẽ được insert 2 lần và nặng file. URL hình có kích thước bao nhiêu khi insert vào file Excel sẽ nặng bấy nhiêu. Bạn có thể xử lý URL resize trước khi bỏ vào file

Sub InsertPictureIntoRange()

    Application.Calculation = xlCalculationManual

    Application.ScreenUpdating = False

    Application.DisplayStatusBar = False

    Application.EnableEvents = False

    ActiveSheet.DisplayPageBreaks = False

  Dim LastRow As Integer

    Dim RowRunner As Integer

    Dim ImageURL As String

    Dim ColumnIndex As Integer

    Dim LastColumn As Integer

    Dim SheetName As Integer

    On Error Resume Next

    Set ImageSheet = ActiveWorkbook.ActiveSheet

    LastRow = ImageSheet.Range("B" & Rows.Count).End(xlUp).Row

'Dòng chứa data cần insert hình cuối cùng, ở đây ta dùng cột B để tính

    ColumnIndex = 1

'(khai báo cột sẽ insert hình vào(điền 1 thì là cột A)

    For RowRunner = 3 To LastRow

'Rowrunner=3=>sẽ chạy insert hình từ dòng 3 trở xuống-tạo vòng lặp bắt đầu từ dòng 3 cho đến dòng cuối)

        ImageURL = Cells(RowRunner, ColumnIndex).Value

        If Len(ImageURL) > 0 Then

Set myPicture = ImageSheet.Pictures.Insert(ImageURL)

'Kéo dài rộng hình cho gọn trong ô

            With myPicture

            'Resize thumbnails according to personal references

            'The below is default to be at the center of the cell and 80-90% filled

                .ShapeRange.LockAspectRatio = msoTrue

                .Width = Cells(RowRunner, ColumnIndex).Width - 5

                .Height = Cells(RowRunner, ColumnIndex).Height - 5

                .Top = Rows(Cells(RowRunner, ColumnIndex).Row).Top + (Rows(Cells(RowRunner, ColumnIndex).Row).Height - .Height) / 2

                .Left = Columns(Cells(RowRunner, ColumnIndex).Column).Left + (Columns(Cells(RowRunner, ColumnIndex).Column).Width - .Width) / 2

            End With

        End If

        ImageURL = vbNullString

    Next RowRunner

    Application.Calculation = xlCalculationAutomatic

    Application.ScreenUpdating = True

    Application.DisplayStatusBar = True

    Application.EnableEvents = True

    ActiveSheet.DisplayPageBreaks = True

End Sub

Kết quả:(URL mình copy ngẫu nhiên từ GOOGLE)