VBA - Create a thumbnail on Loadpicture() in a Userform

Question

I'm loading pictures in multiple Image controls on a Userform using Loadpicture(), to create some kink of previews. (The user can then click on the Image to open the full size picture).

Since the preview Image on the Userform are about 1cm tall, I would like to load a thumbnail (smaller file size versions) of the pictures to limit memory usage, while still keeping the full-sized (megapixels) source pictures on the hard drive.

Is there a way to resize the picture imported at the loading event ?

PS : I'm not trying to change the visible height/width of the picture since PictureSizeMode is set to fmPictureSizeModeZoom.

@TimWilliams. That's not the answer I'm looking for :-(, but at least that the word ('thumbnail') I was looking for ! Thx — Tibo
– Tibo, Commented Jul 13, 2017 at 5:46

Robin Mackenzie · Accepted Answer · 2017-07-13 09:06:52Z

2

There's a hack-y way around to do this - basically:

create a temp Worksheet
create a shape and load the picture to it and resize the picture
create a temp Chart and paste the re-sized picture onto it
export the Chart to a temp file
delete the temp Worksheet
load the temp file to the UserForm
delete the temp file

It is a bit ghastly, but it works. You might want to consider using Application.ScreenUpdating = False whilst the code is running, but it is useful to step through the code below to see how it works.

Option Explicit

Private Sub UserForm_Initialize()

    ' size of thumbnail
    Dim lngSide As Long
    lngSide = 50

    ' input jpg and temp file path
    Dim strInPath As String
    Dim strOutPath As String
    strInPath = Environ("USERPROFILE") & "\Desktop\Capture.JPG"
    strOutPath = Environ("USERPROFILE") & "\Desktop\temp.JPG"

    ' add a temp worksheet
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets.Add

    ' load picture to shape and RESIZE
    Dim shp As Shape
    Set shp = ws.Shapes.AddPicture(Filename:=strInPath, _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoCTrue, _
        Left:=20, _
        Top:=20, _
        Width:=lngSide, _
        Height:=lngSide)

    ' create a chart
    Dim cht As Chart
    Set cht = ws.Shapes.AddChart(xlColumnClustered, _
        Width:=lngSide, _
        Height:=lngSide).Chart

    ' copy shape picture to chart and export to temp file
    shp.Copy
    cht.Paste
    cht.Export Filename:=strOutPath, FilterName:="jpg"

    ' remove temp sheet (including shape and chart) with no alerts
    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True

    ' load resized temp picture to image control
    With Me.Image1
        .Height = lngSide
        .Width = lngSide
        .Picture = LoadPicture(strOutPath)
    End With

    ' delete the temp file
    Kill strOutPath

End Sub

answered Jul 13, 2017 at 9:06

Robin Mackenzie

19.4k7 gold badges42 silver badges63 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

Tibo Over a year ago

Keep in mind that "I would like to load a thumbnail ... to limit memory usage" and eventually save a few ms on execution. I doubt loading the full-sized image then exporting to disk then importing again, all while adding/deleting sheets and dealing with multiple shapes would be more efficient.

Tim Williams Over a year ago

@Tibo - if OP's collection of images is fixed then they only need to do this once. If not then your point is well-made of course.

Tibo Over a year ago

You're right. I totally forgot to mention that pictures are indeed downloaded (and saved on disk, only once in a while) then loaded dynamically (on user imput) and expected to change very frequently.

Collectives™ on Stack Overflow

VBA - Create a thumbnail on Loadpicture() in a Userform

1 Answer 1

3 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

3 Comments

Your Answer

Sign up or log in

Post as a guest

Related