使用VBA向Excel插入竖版4:3/16:9图片时宽高识别颠倒问题

我近期尝试编写代码实现在Excel单元格内插入图片，目前整体效果较好，参考了本站多篇VBA插入图片相关的帖子。
我遇到的现象如下：

• 适配竖版4:3或16:9比例的图片时功能失效，图片高度会超出单元格高度
• 通过VBA直接读取图片尺寸时，返回结果显示宽度大于高度。若对该图片做轻微裁剪后再插入，代码即可正常运行，读取到的尺寸也正确
  看起来对于竖版的4:3、16:9格式图片，Excel会互换识别图片的宽高维度。

更新1：测试代码与测试图片 #

以下是我使用的原始代码：

Sub Pictures()
  
Dim wb As Workbook
Set wb = ActiveWorkbook
    
counter = 0

    strCompFilePath = wb.Sheets("List").Cells(1, 1)
        If strCompFilePath <> "" Then
            counter = counter + 1
            Sheets("Template").Activate
            Sheets("Template").Range("A" & counter).RowHeight = 250
            Call Insert(strCompFilePath, counter)
        End If
                            
End Sub
Function Insert(PicPath, counter)

    Dim l, r, t, b
    Dim w, h      ' 目标单元格范围的宽高
    Dim aspect     ' 插入图片的宽高比

    l = 1: r = 8    ' 左上角单元格坐标
    t = counter: b = counter    ' 右下角单元格坐标

    With Sheets("Template").Pictures.Insert(PicPath)
        With .ShapeRange
             .LockAspectRatio = msoTrue
            .Width = Range("H" & counter).Left + Range("H" & counter).Width - Range("A" & counter).Left
            .Height = Range("H" & counter).Top + Range("H" & counter).Height - Range("A" & counter).Top
            aspect = .Width / .Height     ' 计算图片宽高比
            .Top = Range("A" & counter).Top + (Range("A" & counter).Height - .Height) / 2                 ' 图片垂直居中
            .Left = Range("A" & counter).Left + Range("A:H").Left + (Range("A:H").Width - .Width) / 2     ' 图片水平居中
        End With
        .Placement = 1 ' 对象随单元格移动和调整大小
        .PrintObject = True
    End With
    
End Function

测试图片：

更新2：优化代码测试结果 #

以下是优化后的测试代码：

Sub Pictures()
  
Dim wb As Workbook
Set wb = ActiveWorkbook
    
counter = 5

    strCompFilePath = wb.Sheets("List").Cells(1, 1)
        If strCompFilePath <> "" Then
            counter = counter + 1
            Sheets("Template").Activate
            Sheets("Template").Range("A" & counter).RowHeight = 250
            Call Insert(strCompFilePath, counter)
        End If
                            
End Sub
Function Insert(PicPath, counter)

With Sheets("Template").Pictures.Insert(PicPath)
    With .ShapeRange
        .LockAspectRatio = msoTrue
        .Height = 250
        .Top = Range("A" & counter).Top + (Range("A" & counter).Height - .Height) / 2                 ' 图片垂直居中
        .Left = Range("A" & counter).Left + Range("A:H").Left + (Range("A:H").Width - .Width) / 2     ' 图片水平居中
    End With
        .Placement = 1 ' 对象随单元格移动和调整大小
        .PrintObject = True
    End With
    
End Function

其中.Height = 250这行代码并未生效。目前判断代码本身无问题，问题出在Excel端对图片宽高的识别逻辑。

问题原因 #

该问题的核心诱因是Excel没有正确识别图片的EXIF旋转元数据：

1. 手机、相机拍摄的竖版照片，通常不会直接调整像素矩阵的宽高排列，而是在EXIF信息中标记Orientation旋转参数，告知查看软件需要旋转90度/270度显示为竖版。
2. Excel的Pictures.Insert方法默认不会读取该旋转参数，只会按照像素矩阵的原始宽高读取，原本竖版的图片像素矩阵实际为横版排列，因此会出现宽高颠倒的情况。
3. 对图片进行裁剪操作后，图片编辑工具会直接修改像素矩阵的排列，同时更新对应的EXIF旋转参数，因此Excel再读取时宽高就会恢复正常。

修复方案 #

可通过两种方案解决该问题：

1. 插入图片后先校验EXIF旋转参数，根据旋转角度手动调换宽高值后再进行适配缩放
2. 插入后先解除宽高比锁定，读取原始像素宽高和目标单元格宽高，计算适配比例后再统一缩放，避免直接设置高度/宽度触发的比例计算错误

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