如何用VBA获取Word文档中图片的真实分辨率？

问题背景 #

需要用VBA遍历Word文档中的所有图片，检查其分辨率是否至少达到600dpi。测试用图为Illustrator创建的1000dpi、70×40mm图片，原像素2756×1575。导入Word后尺寸显示正确，另存图片可导出原像素尺寸，但现有VBA代码仅返回96dpi对应的数值，无法获取真实信息。

现有代码 #

Sub GetImageResolutions()
    Dim i As Integer
    Dim shape As InlineShape
    Dim resolution As String
    Dim dpi As Double
    Dim width, height As Integer
    
    Debug.Print "Number of images: " & ActiveDocument.InlineShapes.Count
    For i = 1 To ActiveDocument.InlineShapes.Count
        Set shape = ActiveDocument.InlineShapes(i)
        If shape.Type = wdInlineShapePicture Then
            ' Determining original width before scaling
            width = shape.width / shape.ScaleWidth * 100
            height = shape.height / shape.ScaleHeight * 100
            ppi = width / (shape.width / 96)
            Debug.Print "Image " & i & ": "
            Debug.Print shape.width & "x" & shape.height & " points, " & shape.width / 72 * 96 & "x" & shape.height / 72 * 96 & " - " & shape.ScaleWidth & " " & shape.ScaleHeight
            Debug.Print width & " x " & height & " points (scaled)"
            Debug.Print PointsToPixels(width, False) & " x " & PointsToPixels(height, True) & " pixels"
            Debug.Print "resolution: " & ppi
        End If
    Next i
End Sub

代码运行结果 #

Image 1:
198,35x113,45 points, 264,4667x151,2667 - 100 100
198,35 x 113 points (scaled)
264 x 150 pixels
resolution: 96

补充说明 #

将Word文件解压后，word\media文件夹中的图片可显示真实像素尺寸（示例为2756×1757），需直接从InlineShape对象获取该信息。

解决方案 #

Word的InlineShape对象本身不存储图片原始像素数据，需通过以下两种方法获取真实信息：

方法1：临时导出图片读取元数据 #

将图片临时导出到本地，通过WIA组件读取原始像素和分辨率，代码如下：

Sub GetRealImageResolution()
    Dim i As Integer
    Dim shape As InlineShape
    Dim tempPath As String
    Dim img As Object
    Dim originalWidthPx, originalHeightPx As Long
    Dim dpiX, dpiY As Double
    
    ' 生成唯一临时文件路径
    tempPath = Environ("TEMP") & "\temp_word_img_" & Format(Now, "YYYYMMDDHHMMSS") & ".png"
    
    Debug.Print "Number of images: " & ActiveDocument.InlineShapes.Count
    For i = 1 To ActiveDocument.InlineShapes.Count
        Set shape = ActiveDocument.InlineShapes(i)
        If shape.Type = wdInlineShapePicture Then
            ' 导出图片到临时路径
            shape.Export FileName:=tempPath, Filter:=wdExportFilterPNG
            
            ' 加载图片并读取元数据
            Set img = CreateObject("WIA.ImageFile")
            img.LoadFile tempPath
            
            originalWidthPx = img.Width
            originalHeightPx = img.Height
            dpiX = img.HorizontalResolution
            dpiY = img.VerticalResolution
            
            ' 计算Word中显示的等效分辨率
            Dim displayWidthPoints As Double
            displayWidthPoints = shape.Width / shape.ScaleWidth * 100
            Dim displayDPI As Double
            displayDPI = originalWidthPx / (displayWidthPoints / 72) ' 1英寸=72磅
            
            ' 输出结果
            Debug.Print "Image " & i & ":"
            Debug.Print "原始像素尺寸: " & originalWidthPx & "x" & originalHeightPx
            Debug.Print "原始分辨率: " & dpiX & "dpi (水平), " & dpiY & "dpi (垂直)"
            Debug.Print "Word显示等效分辨率: " & Round(displayDPI, 2) & "dpi"
            Debug.Print "是否达标(≥600dpi): " & IIf(dpiX >= 600 And dpiY >= 600, "是", "否")
            
            ' 删除临时文件
            Kill tempPath
        End If
    Next i
End Sub

注：WIA组件为Windows系统默认自带，若缺失可通过「控制面板-程序-启用或关闭Windows功能」开启。

方法2：解析Word的OXML结构 #

Word文档本质是ZIP包，可通过VBA解压后读取word\media中图片的元数据，或直接解析文档OXML内容匹配图片ID获取信息。该方法无需导出图片，但代码复杂度较高，适合熟悉OXML规范的开发者。

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