Excel VBA图像EXIF方向

Question

制作此宏,将活动目录中的图像插入到Excel电子表格中,然后将其缩小以适应单元格.除了来自源的图像,它们的方向/旋转在EXIF数据中定义之外,它的效果非常好.所以在:

• 在Windows资源管理器中 - 不旋转
• 窗口图片查看器 - 未旋转
• IE - 不旋转
• Chrome - 旋转
• EXCEL - 旋转

这完全归功于相机的一些遗留问题,即拍摄图像.有人发布了类似的问题,但它被标记为重复,错误,并且自那以后一直被忽略.我确实发现这个不起眼的帖子是有人联系了一个exif阅读器类,我测试了它,它给了我Orientation所有图像的相同值.

问题:照片正常旋转(YAY!),但它的位置是向右(Boo!)和/或200行向下35-80列,并且缩放因为它混合了宽度和高度字段(Boo) !x2).

这是我的代码:

For Each oCell In oRange
        If Dir(sLocT & oCell.Text) <> "" And oCell.Value <> "" Then
        'Width and Height set to -1 to preserve original dimensions.
            Set oPicture = oSheet.Shapes.AddPicture(Filename:=sLocT & oCell, LinktoFile:=msoFalse, savewithdocument:=msoTrue, Left:=oCell.Left + 10, Top:=oCell.Top + 10, Width:=-1, Height:=-1)

            oPicture.LockAspectRatio = True

        'Scales it down  
            oPicture.Height = 200
        'Adds a nice margin in the cell, useless             
            oCell.RowHeight = oPicture.Height + 20
            oCell.ColumnWidth = oPicture.Width / 4
        Else

            oCell.Offset(0, 1).Value = ""
        End If
        Next oCell

图像尺寸可以从未知来源变化(但我很确定我们可以归咎于三星).寻找解决方案和/或解释,而无需第三方应用程序.

这是一个要试用的图像样本,第一个图像正常工作,其他图像没有.

Answer 1

You have to check the rotation to see if you have to adjust height or Width (Top or Left)

Adjust your loop as follows:

For Each oCell In oRange
        If Dir(sloct & oCell.Text) <> "" And oCell.Value <> "" Then
          Set oPicture = osheet.Shapes.AddPicture(Filename:=sloct & oCell, LinktoFile:=msoFalse, savewithdocument:=msoTrue, Left:=oCell.Left + 10, Top:=oCell.Top + 10, Width:=-1, Height:=-1)

          With oPicture
                .LockAspectRatio = True
            If .Rotation = 0 Or .Rotation = 180 Then
                .Height = 200
                 oCell.RowHeight = .Height + 20
                 oCell.ColumnWidth = .Width / 4
                .Top = oCell.Top
                .Left = oCell.Left
            Else
                .Width = 200
                oCell.RowHeight = .Width + 20
                oCell.ColumnWidth = .Height / 4
                .Top = oCell.Top + ((.Width - .Height) / 2)
                .Left = oCell.Left - ((.Width - .Height) / 2)
            End If

           End With
        Else
            oCell.Offset(0, 1).Value = ""
        End If
        Next oCell