如何将本地表OLE对象图片转为IPictureDisp用于自定义命令栏

核心思路 #

通过Windows API在内存中创建数据流，将OLE字段提取的图片字节数组写入内存流，再通过OleLoadPicture接口加载流生成IPictureDisp对象，全程无需将图片保存为本地文件，直接用于CommandBar控件的Picture和Mask属性。

代码实现 #

首先在VBA模块中声明所需的Windows API和类型：

Option Explicit

#If VBA7 Then
    Declare PtrSafe Function CreateStreamOnHGlobal Lib "ole32.dll" (ByVal hGlobal As LongPtr, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
    Declare PtrSafe Function OleLoadPicture Lib "olepro32.dll" (ByVal pStream As IUnknown, ByVal lSize As Long, ByVal fRunmode As Long, ByRef riid As GUID, ppvObj As Any) As Long
    Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal uFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
    Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
    Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As Long
    Declare PtrSafe Function CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal dest As LongPtr, ByVal src As LongPtr, ByVal cb As LongPtr) As Long
    Type GUID
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(0 To 7) As Byte
    End Type
#Else
    Declare Function CreateStreamOnHGlobal Lib "ole32.dll" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
    Declare Function OleLoadPicture Lib "olepro32.dll" (ByVal pStream As IUnknown, ByVal lSize As Long, ByVal fRunmode As Long, ByRef riid As GUID, ppvObj As Any) As Long
    Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
    Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
    Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
    Declare Function CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal dest As Long, ByVal src As Long, ByVal cb As Long) As Long
    Type GUID
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(0 To 7) As Byte
    End Type
#End If

Const GMEM_MOVEABLE = &H2
Const IID_IPictureDisp As String = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"

然后实现字节数组转IPictureDisp的核心函数：

Function BytesToIPictureDisp(ByVal picBytes() As Byte) As IPictureDisp
    Dim hGlobal As LongPtr
    Dim pLock As LongPtr
    Dim pStream As IUnknown
    Dim iid As GUID
    Dim hr As Long
    
    ' 初始化GUID为IPictureDisp的IID
    With iid
        .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
    
    ' 分配可移动的全局内存
    hGlobal = GlobalAlloc(GMEM_MOVEABLE, UBound(picBytes) - LBound(picBytes) + 1)
    If hGlobal = 0 Then Exit Function
    
    ' 锁定内存并写入字节数组
    pLock = GlobalLock(hGlobal)
    If pLock <> 0 Then
        CopyMemory pLock, VarPtr(picBytes(LBound(picBytes))), UBound(picBytes) - LBound(picBytes) + 1
        Call GlobalUnlock(hGlobal)
        
        ' 创建内存流
        hr = CreateStreamOnHGlobal(hGlobal, 1, pStream)
        If hr = 0 Then
            ' 从流加载图片为IPictureDisp
            hr = OleLoadPicture(pStream, 0, 0, iid, BytesToIPictureDisp)
        End If
    End If
End Function

调用示例 #

假设你已经从Access表中提取了图片的字节数组（存储在imgBytes变量中），现在将其应用到CommandBar按钮：

Sub ApplyPictureToCommandBar()
    Dim cmdBar As CommandBar
    Dim cmdBtn As CommandBarButton
    Dim imgBytes() As Byte
    Dim picDisp As IPictureDisp
    Dim maskDisp As IPictureDisp ' 如果需要设置掩码
    
    ' 1. 从OLE字段读取字节数组（示例：从表"Images"中读取ID=1的图片）
    imgBytes = DLookup("PictureField", "Images", "ID=1")
    
    ' 2. 转换为IPictureDisp
    Set picDisp = BytesToIPictureDisp(imgBytes)
    
    ' （可选）如果需要设置掩码，可单独处理掩码字节数组，重复转换步骤
    ' maskBytes = DLookup("MaskField", "Images", "ID=1")
    ' Set maskDisp = BytesToIPictureDisp(maskBytes)
    
    ' 3. 获取目标CommandBar按钮并赋值
    Set cmdBar = Application.CommandBars("自定义菜单")
    Set cmdBtn = cmdBar.Controls("自定义命令")
    
    Set cmdBtn.Picture = picDisp
    ' Set cmdBtn.Mask = maskDisp ' 如有掩码则启用
End Sub

注意事项 #

• 确保OLE字段中存储的是标准图片格式（如BMP、ICO），OleLoadPicture支持常见的图片格式；
• 若图片包含透明通道，建议单独存储掩码字节数组并设置Mask属性，否则CommandBar按钮可能显示异常；
• 代码兼容32位和64位Office版本，需在VBA编辑器中启用"信任对VBA项目对象模型的访问"。

内容的提问来源于stack exchange，提问作者Adelina Andreea trandafir