如何直接从剪贴板获取图片字节？VBA技术需求与问题

核心解决方案：用Windows API直接读取剪贴板图片数据 #

要解决FORMATETC未定义的问题，需先在模块顶部声明必要的Windows API类型与函数，全程内存内操作，无需磁盘读写。

步骤1：声明API与类型

在VBA模块最顶部添加以下代码：

' Windows API 声明与类型定义
Private Type FORMATETC
    cfFormat As Long
    ptd As Long
    dwAspect As Long
    lindex As Long
    tymed As Long
End Type

Private Type STGMEDIUM
    tymed As Long
    pUnkForRelease As Long
    unionmember As Long
End Type

Private Declare Function OleGetClipboard Lib "ole32.dll" (ppDataObj As Object) As Long
Private Declare Function ReleaseStgMedium Lib "oleaut32.dll" (pStgMedium As STGMEDIUM) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32.dll" (hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

步骤2：编写剪贴板图片字节获取函数

添加以下函数，负责从剪贴板提取图片的字节数组：

Private Function GetClipboardImageBytes() As Byte()
    Dim dataObj As Object
    Dim fmtetc As FORMATETC
    Dim stgmed As STGMEDIUM
    Dim hMem As Long
    Dim pMem As Long
    Dim byteCount As Long
    Dim byteArr() As Byte
    
    ' 获取剪贴板数据对象
    If OleGetClipboard(dataObj) <> 0 Then Exit Function
    
    ' 设置格式为PNG（若为BMP可替换为CF_BITMAP=&H2）
    With fmtetc
        .cfFormat = &H6D00 ' CF_PNG格式
        .dwAspect = 1 ' DVASPECT_CONTENT
        .tymed = 2 ' TYMED_HGLOBAL
    End With
    
    ' 提取剪贴板图片数据
    On Error Resume Next
    dataObj.GetData fmtetc, stgmed
    On Error GoTo 0
    
    If stgmed.tymed = 2 Then
        hMem = stgmed.unionmember
        pMem = GlobalLock(hMem)
        byteCount = GlobalSize(hMem)
        
        If byteCount > 0 Then
            ReDim byteArr(0 To byteCount - 1)
            CopyMemory byteArr(0), ByVal pMem, byteCount
        End If
        
        GlobalUnlock hMem
        ReleaseStgMedium stgmed
    End If
    
    GetClipboardImageBytes = byteArr
End Function

步骤3：整合到现有遍历代码中

修改你的getImageBytes过程，将每个图片的字节数组存入字典关联，同时解决JAWS适配问题：

Public Sub getImageBytes()
    Dim ws As Worksheet
    Dim shp As Shape
    Dim byteDict As Object ' 存储字节数组与图片的关联
    
    Set ws = ThisWorkbook.Worksheets("Report")
    Set byteDict = CreateObject("Scripting.Dictionary")
    
    For Each shp In ws.Shapes
        shp.CopyPicture xlScreen, xlPicture
        Dim imgBytes() As Byte
        imgBytes = GetClipboardImageBytes()
        
        If UBound(imgBytes) >= 0 Then
            ' 给图片添加JAWS友好的Alt文本，替换默认的"image 1"
            shp.AlternativeText = "分类状态标识" ' 可后续根据字节匹配结果动态设置更精准描述
            byteDict.Add shp.Name, imgBytes
        End If
    Next shp
    
    ' 后续可遍历byteDict进行字节模式匹配、分类总计计算
End Sub

更高效优化：直接从Shape提取字节（无需剪贴板） #

跳过剪贴板环节，直接将Shape导出到内存流获取字节，速度更快：

Private Function ShapeToBytes(shp As Shape) As Byte()
    Dim tempStream As Object
    Set tempStream = CreateObject("ADODB.Stream")
    
    tempStream.Type = 1 ' adTypeBinary
    tempStream.Open
    shp.Picture.Save tempStream ' 图片保存到内存流
    tempStream.Position = 0
    ShapeToBytes = tempStream.Read
    tempStream.Close
End Function

使用时直接替换GetClipboardImageBytes()为ShapeToBytes(shp)即可。

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