Get all images from worksheet and display them on the Userform

Mr.Housaka shows an excellent way. This code originate from the example on the Mr.Housaka' web site.

The way is something like this... Excel workbook can be saved as HTML format. When the file is saved, all images are saved in the another temporaly folder.

This program will make a copy of this workbook with SaveCopyAs method and open that copied file then save it as a HTML format again.

After that, load all images to the image controls on the Userform from that temporaly folder.

- Worksheet image -

- Userform image -

Place following in the standard module. You can also download the sample file from here.

Please note, if this code doesn't work, please change tmp_files to tmp.files in the following code line.

sTmpFolder = sDeskTop & "tmp_files" & _

I think that it depends on the kind of the OS. When I ran this code on Windows2000, it worked as it is. When I tested this program on WindowsXP, I needed to change tmp_files to tmp.files. I'll write additional tips when I find some about this matter.

Option Explicit

Sub DisplayImagesInTheWkbOnTheForm()

    Dim sTmpFName As String
    Dim sTmpFile As String
    Dim sTmpFolder As String
    Dim sFileName As String
    Dim vTypes As Variant
    Dim vType As Variant
    Dim sglTop As Single
    Dim sglLeft As Single
    Dim oWS As Object
    Dim sDeskTop As String
    Dim sglHeightMax As Single

    Set oWS = CreateObject("WScript.Shell")
    'Get desk top path
    sDeskTop = oWS.SpecialFolders("Desktop") & _

    vTypes = Array("jpg", "gif")
    sTmpFName = sDeskTop & "temp.xls"
    sTmpFile = sDeskTop & "tmp.html"
    sTmpFolder = sDeskTop & "tmp_files" & _

    Application.ScreenUpdating = False

    ThisWorkbook.SaveCopyAs sTmpFName

    With Workbooks.Open(sTmpFName)
        .DisplayDrawingObjects = xlDisplayShapes
        Application.DisplayAlerts = False
        .SaveAs sTmpFile, xlHtml
        Application.DisplayAlerts = True
        .Close False
        Kill sTmpFName
        Kill sTmpFile
    End With

    With UserForm1
    'resize form
        .Height = Int(ActiveWindow.Height * 0.98)
        .Width = Int(ActiveWindow.Width * 0.98)

        For Each vType In vTypes
            sFileName = Dir(sTmpFolder & "*." & vType)
            Do Until sFileName = ""
                With .Controls.Add("forms.image.1", sFileName)
                    If sglLeft + .Width > UserForm1.Width Then
                        sglTop = sglTop + sglHeightMax
                        sglLeft = 0
                    End If
                    .Top = sglTop
                    .Left = sglLeft
                    .AutoSize = True
                    .Picture = LoadPicture(sTmpFolder & sFileName)
                    If .Height > sglHeightMax Then sglHeightMax = .Height
                    'sglTop = .Top
                    sglLeft = .Left + .Width
                End With
                sFileName = Dir()

        Application.ScreenUpdating = True
    End With
End Sub

| HOME |
Copyright © cellmasters.net - colo's junk room All Right Reserved
Tips and Information about Microsoft Excel|Masaru Kaji aka Colo