Excel VBA图像EXIF方向 [英] Excel VBA Image EXIF Orientation

问题描述

创建此宏，该宏将活动目录中的图像插入到Excel电子表格中，并按比例缩小以适合单元格.除了来自源的图像(其方向/旋转在EXIF数据中定义)以外，它的效果都很好.所以在:

Made this macro that inserts images from the active directory into an excel spreadsheet and scales it down to fit in the cell. It works pretty well except for images that come from a source were their orientation/rotation is defined in the EXIF data. So in:

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

这都是由于一些旧问题造成的来自拍摄图像的相机.有人发布了晦涩的帖子是有人链接了exif阅读器类，我对此进行了测试它为我的所有图像赋予了相同的Orientation值.

It's all due to some legacy issue from the camera that the image was taken from. Somebody post a similar problem but it got labelled as a duplicate, incorrectly, and has been ignored since. I did find this obscure post were somebody linked an exif reader class, I tested it and it gave me the same Orientation value for all my images.

问题:照片已正确旋转(是！)，但其位置在右边35-80列(嘘！)和/或200行向下，并且缩放比例无效，因为它混合了宽度和高度字段(Boo！x2).

The Problems: the photo gets rotated properly (YAY!), but its position is 35-80 columns to the right (Boo!) and/or 200 rows down, and the scaling is off because it mixes the width and height fields (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

图像尺寸可能因未知来源而异(但我敢肯定，我们可以将三星归咎于此).在不需要第三方应用程序的情况下寻找解决方案和/或解释.

Image dimensions can be variable from unknown sources (but I'm pretty sure we can blame Samsung on this one). Looking for a solution and/or an explanation without the need of a 3rd party application.

这是一个图像样本，第一张图片可以正常工作，其他图片则不能.

Here's a sample of the images to try out, the first image works properly, the others don't.

推荐答案

您必须检查旋转角度，以查看是否必须调整高度或宽度(顶部或左侧)

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

如下调整循环:

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

这篇关于Excel VBA图像EXIF方向的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！