Excel VBA 图片 EXIF 方向
Excel VBA Image EXIF Orientation
制作此宏,将活动目录中的图像插入 excel 电子表格并将其缩小以适合单元格。它工作得很好,除了来自来源的图像是它们的 orientation/rotation 在 EXIF 数据中定义的。所以在:
- 在 Windows 资源管理器中 - 未旋转
- Window 图片查看器 - 未旋转
- IE - 未旋转
- Chrome - 旋转
- EXCEL - 旋转
这都是因为 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 有人链接了一个 exif reader class,我测试了它,它为我所有的图像提供了相同的 Orientation
值。
问题:照片正确旋转(耶!),但它的 位置 是向右 35-80 列( Boo!) and/or 向下 200 行,缩放比例关闭,因为它混合了宽度和高度字段 (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
图像尺寸可能会因未知来源而变化(但我很确定我们可以将此归咎于三星)。寻找解决方案 and/or 不需要第三方应用程序的解释。
这里有一个 sample of the images 可以试用,第一张图片可以正常使用,其他的则不行。
您必须检查旋转以查看是否需要调整高度或宽度(顶部或左侧)
按如下方式调整循环:
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 电子表格并将其缩小以适合单元格。它工作得很好,除了来自来源的图像是它们的 orientation/rotation 在 EXIF 数据中定义的。所以在:
- 在 Windows 资源管理器中 - 未旋转
- Window 图片查看器 - 未旋转
- IE - 未旋转
- Chrome - 旋转
- EXCEL - 旋转
这都是因为 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 有人链接了一个 exif reader class,我测试了它,它为我所有的图像提供了相同的 Orientation
值。
问题:照片正确旋转(耶!),但它的 位置 是向右 35-80 列( Boo!) and/or 向下 200 行,缩放比例关闭,因为它混合了宽度和高度字段 (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
图像尺寸可能会因未知来源而变化(但我很确定我们可以将此归咎于三星)。寻找解决方案 and/or 不需要第三方应用程序的解释。
这里有一个 sample of the images 可以试用,第一张图片可以正常使用,其他的则不行。
您必须检查旋转以查看是否需要调整高度或宽度(顶部或左侧)
按如下方式调整循环:
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