EXCEL-VBA: Macro tạo Catalog Excel với hình ảnh từ URL

Hiện nay, việc quản lý tài nguyên (hình ảnh, video, file 3D...) thông qua các dịch vụ lưu trữ bên thứ ba đã trở nên rất phổ biến. Mỗi tệp tin sau khi tải lên sẽ được định danh bằng một đường dẫn URL duy nhất.

Bài toán đặt ra là: Cần tạo một Catalog sản phẩm bằng Excel, trong đó:

Cột A: Chứa URL của ảnh và bạn muốn hình ảnh hiển thị gọn gàng ngay trong ô đó (sau khi đã định dạng kích thước cột/hàng phù hợp).

Các cột B, C, D...: Chứa thông tin chi tiết của sản phẩm.

Vấn đề là gì?

Chắc chắn bạn sẽ không muốn làm theo cách thủ công: tải từng tấm hình về máy, dùng lệnh Insert để chèn vào Excel, rồi lại hì hục căn chỉnh kích thước cho từng tấm một. Nếu danh sách có hàng trăm, hàng ngàn sản phẩm, đây thực sự là một "cơn ác mộng" về thời gian và công sức.

Vậy làm thế nào để "đổ" hình ảnh từ URL vào thẳng ô Excel một cách tự động và chuẩn xác?

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ý bằng 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)