Question

我希望创建一个Treeview，其中包含工作表中的图像和数据（每行都有一个部件的名称，它的下一个组件和一个由用户填充的图标）。我终于设法让树视图正确填充并包含来自外部源的图像（基于来自各种来源的代码和我自己的一些代码）。设置图像列表并将其分配给Treeview对我来说仍然是一个谜，但它确实有效。

缺少的是从工作表内部到图像列表而不是从外部源（（使用iml.ListImages.Add 1, "img1", LoadPicture("C:\Temp\red.jpg")）获取图片。我阅读了几十篇关于它的帖子无济于事，并且有一个在几个地方提到但是是一个deadend。我读过的另一个选择是将图片复制到剪贴板并粘贴到其他地方，但它涉及很多代码而且似乎超出了我的能力，所以我还没有尝试过。

我可以＆＃34;阅读＆＃34;工作表中的图片属性使用Sheet1.Shapes(1)或类似于.Type（结果为＆＃34; 13＆＃34;）或.Name（返回＆＃34;图片1＆＃34） ;例如）或.TopLeftCell.Address（返回＆＃34; $ C $ 1＆＃34;例如）等等。所以我知道我可以访问它们并引用正确的对象。

当我尝试使用iml.ListImages.Add 1, "img1", Sheet1.Shapes(1)时，我得到一张＆＃34;无效图片＆＃34;错误。

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

当我尝试使用iml.ListImages.Add 1, "img1", Sheet1.Shapes(1).CopyPicture时，我得到了＃34;类型不匹配＆＃34;错误。

我不知道还有什么可以尝试以及在哪里可以看。请帮忙。

编辑：所有这些都发生在用户表单中。

Answer 1

您使用的是UserForm吗？如果是这样，这是针对您的问题的建议或更多解决方法。

为什么工作表中的图像会尝试在表单中加载？也许首先尝试在UserForm中使用它们，这是如何。

在您的用户表单上创建一个框架： Frame http://im88.gulfup.com/Moy8I6.png

将框架的可见属性设置为＆＃34; False ＆＃34;： Visible http://im88.gulfup.com/sAIQqh.png

通过添加图片控件插入图像并加载图像，您可以根据需要添加任意数量的图像： Images http://im88.gulfup.com/oas0EQ.png

为图片命名： Name http://im88.gulfup.com/cIO317.png

将所有图像一个接一个地拖到框架中（然后可以将框架移动到一个角落，这样就不会打扰你了：

Drag http://im88.gulfup.com/1fOSut.png Move Away http://im88.gulfup.com/Q1fzKd.png

接下来创建一个图片控件，这将用于根据选择显示图片：

Form View http://im88.gulfup.com/X1UVRB.png

在这个例子中，我将使用组合框进行选择。现在将以下代码插入到非常简单的表单中：

    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

正如您将看到的，带有图片的框架是隐藏的，并且图片控件内部的图像会根据选择进行更改：

Result http://im88.gulfup.com/MSqyHF.png

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

Answer 2

@SiddhartRout提供了上述评论中的替代方案：“Stephen Bullen的PastePicture代码”如HERE所示。这是我发现的唯一替代方法，它不需要超出文件范围而且工作正常（在示例文件上;仍在等待更大的示例测试）。谢谢大家的帮助。

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

' 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

如何使用工作表中的形状填充图像列表？

2 个答案: