如何通过编程给工作表上的ListView Control 6.0添加背景图（取自其他工作表图片形状）

可以实现，但不能直接将Excel的Shape对象赋值给ListView的Picture属性，因为LoadPicture()需要的是图片文件路径或可识别的图片数据，而Shape是Excel的形状对象，需先转换格式。以下是两种可行方案：

方案1：导出临时图片文件加载 #

通过将工作表中的图片形状导出为临时文件，再用LoadPicture()加载到ListView：

Sub SetListViewBackground()
    Dim tempPicPath As String
    tempPicPath = Environ$("TEMP") & "\ListViewBG.jpg"
    
    ' 将目标图片形状导出为临时文件
    Sheet2.Shapes("Picture 1").Export tempPicPath, jpg
    
    ' 加载临时图片到ListView背景
    ListView1.Picture = LoadPicture(tempPicPath)
    
    ' 可选：清理临时文件
    Kill tempPicPath
End Sub

方案2：通过API直接转换为Picture对象（无需临时文件） #

利用Windows API将Shape中的图片直接转换为IPicture对象，避免生成临时文件：

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _
    ByRef PicDesc As PICTDESC, _
    ByRef RefIID As GUID, _
    ByVal fPictureOwnsHandle As Long, _
    ByRef ppvObj As IPicture) As Long

Private Type PICTDESC
    Size As Long
    Type As Long
    hPic As Long
    hPal As Long
End Type

Sub ShapeToPictureAndSetListView()
    Dim targetShp As Shape
    Dim convertedPic As IPicture
    Set targetShp = Sheet2.Shapes("Picture 1")
    
    ' 复制图片到剪贴板并转换为IPicture对象
    targetShp.CopyPicture xlScreen, xlBitmap
    Set convertedPic = BitmapToPicture(Clipboard.GetData(vbCFBitmap))
    
    ' 赋值给ListView背景
    ListView1.Picture = convertedPic
End Sub

Private Function BitmapToPicture(ByVal hBitmap As Long) As IPicture
    Dim pd As PICTDESC
    Dim iidIPicture As GUID
    
    ' 定义IPicture接口的GUID
    With iidIPicture
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    
    ' 设置图片描述结构
    With pd
        .Size = Len(pd)
        .Type = vbPicTypeBitmap
        .hPic = hBitmap
        .hPal = 0
    End With
    
    ' 创建并返回IPicture对象
    OleCreatePictureIndirect pd, iidIPicture, 1, BitmapToPicture
End Function

为什么原代码无法运行？ #

• LoadPicture(Sheet2.Shapes("Picture 1"))：LoadPicture()的参数必须是图片文件路径或字节数据，Shape对象不符合要求，会触发类型错误。
• ListView1.Picture = Sheet2.Shapes("Picture 1")：ListView的Picture属性仅接受IPicture对象，直接赋值Shape对象会导致类型不匹配。

内容的提问来源于stack exchange，提问作者sifar