Userform needs to display an image based on Listbox selection

PeterMac65

New Member
Joined
May 7, 2020
Messages
11
Office Version
  1. 365
Platform
  1. Windows
Hi
I have a form with ListBox1 and Image1 objects

ListBox1 contains the names of 5-6 images

When a listbox item is selected i want to show the picture in "Image1"

Seems simple but I can't figure how to get the image from the worksheet into the the Userform

Can someone please help me. (NOTE: I copied and pasted an image to show what i'd like to achieve)

Regards PeterMac
1619998214642.png


Option Explicit
Private Sub ListBox1_Click()
Call Pict(ListBox1.ListIndex)
End Sub


Private Sub UserForm_Initialize()
Dim Pic As Object
Dim x As Integer
x = 0
For Each Pic In Sheets("Cost").Shapes 'Pictures
If TypeName(Pic) = "Shape" Then
If Left(Pic.Name, 7) <> "Comment" Then
ListBox1.AddItem Pic.Name
x = x + 1
End If
End If
Next Pic
Debug.Print x
ListBox1.ListIndex = 0
Call Pict(0)
End Sub


Sub Pict(n)
Dim Ans As String
Dim rng As Excel.Range
Dim cht As Excel.ChartObject
Dim Pth As String
Dim Pic As Object
With ListBox1
Set Pic = Sheets("Cost").Shapes(.List(n))
Pic.Copy 'Picture xlScreen, xlBitmap
Debug.Print Pic.Name
Set cht = ActiveSheet.ChartObjects.Add(100, 0, Pic.Width, Pic.Height)

' Me.Image1.Picture = "THIS IS THE BIT I DONT KNOW"

Set cht = Nothing
End With
End Sub
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,758
Office Version
  1. 2016
Platform
  1. Windows
I have found one possible solution based on this thread

You have to get an API based function from this site as mentioned in thread

After modified to 64-bit and ran, unfortunately I get this error
File not found: olepro32.dll

Not sure why but the file is in the Windows\System32.

Maybe I'll try later. Right now too busy with work. Close but no cigar 😁

Here is the code I used
VBA Code:
Private Sub UserForm_Initialize()

Dim shp As Shape
Dim ws As Worksheet

Set ws = ActiveSheet

For Each shp In ws.Shapes
    If shp.Name = "Picture 2" Then
        shp.CopyPicture xlScreen, xlBitmap
        Me.Image1.Picture = PastePicture(xlBitmap)
    End If
Next shp

End Sub
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,758
Office Version
  1. 2016
Platform
  1. Windows
I hope it is not late. I was trying to avoid creating folder and get the image into UserForm from the folder because I think it is winding. However, it is not really that bad.

I inserted 2 picture in my worksheet. Put picture name I wanted to display in the code. The code will loop through all picture in wirksheet to find match and display in UserForm1 which has been created beforehand. It will copy image into directory and link to the UserForm. On the next run, the directory is removed and recreated again for new image.
VBA Code:
Sub DisplayImage()

Const FoldPath As String = "C:\PicFolder"

Dim myChart As String, myPic As String
Dim picWidth As Long, picHeight As Long
Dim FolderExist As Boolean, FileExist As Boolean
Dim shp As Shape
Dim cht As Chart
Dim Pic As Picture
Dim ws As Worksheet

Set ws = ActiveSheet

For Each shp In ws.Shapes
    If shp.Name = "Picture 1" Then
        CreateObject("Scripting.FileSystemObject").DeleteFolder FoldPath
        MkDir FoldPath
        picWidth = shp.Width
        picHeight = shp.Height
        Charts.Add
        Set cht = ActiveChart.Location(Where:=xlLocationAsObject, Name:="Sheet1")
        shp.Copy
        With cht.ChartArea
            .Width = picWidth
            .Height = picHeight
            .Border.LineStyle = 0
            .Select
        End With
        cht.Paste
        cht.Export Filename:=FoldPath & "\" & "MyPic.jpg", FilterName:="jpg"
        ws.ChartObjects(1).Delete
        Exit For
    End If
Next shp
UserForm1.PictureSizeMode = fmPictureSizeModeZoom
UserForm1.Show vbModeless

End Sub
In UserForm
VBA Code:
Private Sub UserForm_Initialize()

Me.Image1.Picture = LoadPicture("C:\PicFolder\MyPic.jpg")

End Sub
 

Forum statistics

Threads
1,143,688
Messages
5,720,305
Members
422,275
Latest member
Maria95

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top