How do you populate imagelist with shape from worksheet? - vba

Question

I wish to create a Treeview with images and data from a worksheet (each line has the name of a part, its next up assembly and an icon all populated by the user). I've finally managed to get the treeview to populate correctly and to include images from an external source (based on code from various sources and just a little of my own).
Setting up the Imagelist and assigning it to the Treeview is still a mystery to me but it works.
What is missing is getting the pictures from inside the worksheet and into the Imagelist instead of from an outside source ((using iml.ListImages.Add 1, "img1", LoadPicture("C:\Temp\red.jpg") ).
I read dozens of posts about it to no avail, and there is one that is mentioned in several places but is a deadend. The one other alternative I've read about involves copying the picture to the clipboard and pasting elsewhere but it involves a lot of code and seemed beyond my capability, so I haven't tried it yet.
I can "read" the pictures properties from the worksheet using Sheet1.Shapes(1) or similar with .Type (which results in "13") or .Name (which returns "Picture 1" for example) or .TopLeftCell.Address (which returns "$C$1" for example) etc. So I know I have access to them and am referencing the correct objects.
When I try to use iml.ListImages.Add 1, "img1", Sheet1.Shapes(1) I get a "Invalid Picture" error.
When I try to use iml.ListImages.Add 1, "img1", Sheet1.Shapes(1).Picture I get a "Object doesn't support this property or method" error.
When I try to use iml.ListImages.Add 1, "img1", Sheet1.Shapes(1).CopyPicture I get a "Type Mismatch" error.
I don't know what else to try and where else to look. Please help.
EDIT:
All this happens within a userform.

Answer 1

Are you using a UserForm? If so here is a suggestion or more of a workaround to your issue.
Why have the images in your worksheet to then try and load them in the form? Maybe try having them in the UserForm in the first place, here is how.
Create a frame on your userform:
Frame http://im88.gulfup.com/Moy8I6.png
Set the visible property of the frame to "False":
Visible http://im88.gulfup.com/sAIQqh.png
Insert your images by adding a picture control and loading the images, you can add as many images as you need:
Images http://im88.gulfup.com/oas0EQ.png
Name the images:
Name http://im88.gulfup.com/cIO317.png
Drag all the images one over the other into the frame, (you can then move the frame into a corner so it doesn't bother you:
Drag http://im88.gulfup.com/1fOSut.png
Move Away http://im88.gulfup.com/Q1fzKd.png
Next create a picture control, this is what you will use to display the picture based on a selection:
Form View http://im88.gulfup.com/X1UVRB.png
In this example, I am going to use a combobox for the selection. Now insert the below code in to the form which is pretty straight forward:
Private Sub ComboBox1_Change()
' Image1 is the name of the created picture control
UserForm3.Controls.Item("Image1").Picture = UserForm3.Controls.Item(UserForm3.ComboBox1.Value).Picture
End Sub
Private Sub UserForm_Initialize()
UserForm3.ComboBox1.AddItem "Argentina"
UserForm3.ComboBox1.AddItem "Brazil"
UserForm3.ComboBox1.AddItem "Chile"
End Sub
As you will see, the frame with the pictures is Hidden, and the image is changing inside the picture control based on a selection:
Result http://im88.gulfup.com/MSqyHF.png
I think it's the better way to go as opposed to exporting the images from the worksheet to a Temp folder and then loading them back into the picture controls.

Answer 2

#SiddhartRout provided the alternative that worked in a comment above: "Stephen Bullen's PastePicture code" as shown HERE. It's the only alternative I found that would not require going outside the file and it worked fine (on a sample file; still pending testing on a bigger example).
Thank you all for the help.
I would like to upload the file with the code etc. but I don't know how to do it, so I'm pasting the part of the "heart" of the code. There are two more modules: one to call the userform and Stephen Bullen's module. The code below is added to the userform itself, and it contains the treeview, the "OK" button and two images called "RED" and "GREEN" which are just small square jpgs of the respective color. I hope this helps.
' based on macros written 19991217 by Ole P. Erlandsen, ope#erlandsendata.no
Option Explicit
Private Sub CommandButton1_Click()
Dim i As Integer, strNodes As String, lngSelCount As Long
Me.Hide
lngSelCount = 0
strNodes = "Checked Items" & Chr(13) & "Index, Key, Text:" & Chr(13)
For i = 1 To TreeView1.Nodes.Count
With TreeView1.Nodes(i)
If .Checked Then
strNodes = strNodes & .Index & "; " & .Key & "; " & .Text & "; " & .Image & Chr(13)
lngSelCount = lngSelCount + 1
End If
End With
Next i
strNodes = strNodes & Chr(13) & "Count of Checked Items: " & lngSelCount
strNodes = strNodes & Chr(13) & Chr(13) & _
"Selected Item" & Chr(13) & "Index, Key, Text:" & Chr(13)
With TreeView1.SelectedItem
strNodes = strNodes & .Index & "; " & .Key & "; " & .Text & "; " & .Image & Chr(13)
End With
MsgBox strNodes, , "TreeView1 Output"
Unload Me
End Sub
Private Sub UserForm_Initialize()
'Author: Paulo Mendonça 02/September/2014 ppmendonca#hotmail.com
Dim oNode, oParent As Node
Dim oCell As Range
Dim oShape As Shape
Dim iml As ImageList
Dim oImage, oSheet, oDataColumn As String
Dim oParentColumnOffset, oImageColumnOffset, oInitialDataRow As Integer
Dim oFound As Boolean
oSheet = "Sheet2"
oDataColumn = "A"
oInitialDataRow = 2
oImageColumnOffset = 2
oParentColumnOffset = 1
'create new ImagList and populate it
Set iml = New ImageList
'iml.ImageHeight = 256
'iml.ImageWidth = 256
iml.ListImages.Add 1, "red", RED.Picture 'defined in UserForm1 and set to invisible
iml.ListImages.Add 2, "green", GREEN.Picture 'defined in UserForm1 and set to invisible
For Each oShape In Sheets(oSheet).Shapes 'look up every shape in the sheet (including non-pictures and add a picture of it in iml
If oShape.Type = 13 Then 'if is picture
If Not PictureKeyExists(oShape.TopLeftCell.Address, iml) Then 'find if picture key exists, if not add it
oShape.CopyPicture xlScreen, xlBitmap 'copy shape to clipboard
iml.ListImages.Add 3, oShape.TopLeftCell.Address, PastePicture(xlBitmap) 'add a picture of the clipboard contents to iml with key = to shapes top left corner cell address
'NOTE: eventhough the index is set to 3 the actual index of the pictures gets incremented automatically
Else 'if yes report to user and don't add it
MsgBox "More than one image in cell " & oShape.TopLeftCell.Address & "." & Chr(13) & _
"Only one will be used."
End If
End If
Next
'set TreeView1 formats etc.
With TreeView1
Set .ImageList = iml
.Indentation = 14
.LabelEdit = tvwManual
.HideSelection = False
.CheckBoxes = True
.Style = tvwTreelinesPlusMinusPictureText
.BorderStyle = ccFixedSingle
End With
'populate TreeView1
With TreeView1.Nodes
.Clear
Set oNode = .Add(, , "Root", "Root Node") 'add root node; key = "Root"
oNode.Expanded = True
oNode.EnsureVisible
'look up all cells from A2 to last cell with content in it and add it to TreeView1
For Each oCell In Sheets(oSheet).Range(oDataColumn & oInitialDataRow, Sheets(oSheet).Range(oDataColumn & "65536").End(xlUp)).SpecialCells(xlCellTypeVisible)
'find if parent exists
Set oParent = Nothing
For Each oNode In TreeView1.Nodes
If oNode.Text = oCell.Offset(0, oParentColumnOffset).Value Then
Set oParent = oNode
Exit For
End If
Next
'find if picture exists, if yes use it, if not use "RED"
If PictureKeyExists(oCell.Offset(0, oImageColumnOffset).Address, iml) Then
oImage = oCell.Offset(0, oImageColumnOffset).Address
Else
oImage = "red"
End If
'add node
If oParent Is Nothing Then 'if parent not found add as child to root; key = name
Set oNode = .Add("Root", tvwChild, oCell.Value, oCell.Value, oImage)
oNode.Expanded = False
Else 'add as child to parent found previously; key = name concatenated to parent node key
Set oNode = .Add(oParent.Key, tvwChild, oParent.Key & "|" & oCell.Value, oCell.Value, oImage)
oNode.Expanded = False
End If
Next
End With
End Sub
Function PictureKeyExists(oKey As String, oImageList As ImageList) As Boolean
'Author: Paulo Mendonça 29/August/2014 ppmendonca#hotmail.com
Dim oPicture As ListImage
PictureKeyExists = False
For Each oPicture In oImageList.ListImages
If oPicture.Key = oKey Then
PictureKeyExists = True
Exit For
End If
Next
End Function