0

I'm using the following script to turn image links into images on Excel sheet. It works great however I have to pull about 1000 images on a spreadsheet for a catalog. When that many images are on the workbook it lags so much even though the images appear tiny (but with original quality). So I'm wondering if anyone can help me adjust my script so the image quality or resolution is reduced. So basically turn a full size image into a small thumbnail that won't take up too much to load. Please let me adjust the resolution so I can test it myself. Here's my code. Appreciate any help!

Option Explicit
Dim rng As Range
Dim cell As Range
Dim Filename As String

Sub URLPictureInsert()
    Dim theShape As Shape
    Dim xRg As Range
    Dim xCol As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    Set rng = ActiveSheet.Range("A1:B500")   
    For Each cell In rng
        Filename = cell
        If InStr(UCase(Filename), "JPG") > 0 Then 
            ActiveSheet.Pictures.Insert(Filename).Select
            Set theShape = Selection.ShapeRange.Item(1)
            If theShape Is Nothing Then GoTo isnill
            xCol = cell.Column + 1
            Set xRg = Cells(cell.Row, xCol)
            With theShape
                .LockAspectRatio = msoFalse
                .Width = 100
                .Height = cell.Height
                .Top = cell.Top + 1
                .Left = cell.Left + 1
            End With
isnill:
            Set theShape = Nothing
            Range("A1").Select
        End If
    Next
    Application.ScreenUpdating = True

    Debug.Print "Done " & Now

End Sub
Techn0way
  • 1
  • 2
  • If you really want to do this then google for Image Resizer c++. Tons of solutions out there. Take one you like, write it in C++ and turn it into a DLL you can call from VBA. Completely doable. – StureS Apr 27 '21 at 16:39
  • https://msaccessgurus.com/VBA/Code/WIA_ResizeImage_GG.htm or https://stackoverflow.com/questions/38351838/excel-vba-save-resized-image-to-file – Tim Williams Apr 27 '21 at 16:45
  • Try this: https://learn.microsoft.com/en-us/office/vba/api/excel.shapes.addpicture2 – DearDeer Apr 28 '21 at 09:36

0 Answers0