vba - Excel VBA 图像 EXIF 方向

标签 vba image excel image-scaling

制作此宏,将事件目录中的图像插入到 Excel 电子表格中,并将其缩小以适合单元格。它工作得很好,除了来自来源的图像,其方向/旋转是在 EXIF 数据中定义的。所以在:

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

这一切都归功于some legacy issue来自拍摄图像的相机。有人发布了similar problem但它被错误地标记为重复项,并且此后一直被忽略。我确实找到了这个obscure post如果有人链接了 exif 阅读器类,我对其进行了测试,它为我的所有图像提供了相同的 Orientation 值。

问题:照片正确旋转(耶!),但其位置向右 35-80 列(嘘!)和/或 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

图像尺寸可能会因未知来源而发生变化(但我很确定我们可以将此归咎于三星)。寻找解决方案和/或解释,而不需要第三方应用程序。

这是一个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

关于vba - Excel VBA 图像 EXIF 方向,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/51400088/

相关文章:

excel - 使用公式标准引用外部工作簿中的命名范围

vba - 如何根据其他单元格的值获取单元格中的真/假值?

xml - 使用 VBA 提交 Soap XML

python - 如何使用 openCV-python 识别白色背景上的多张照片?

vba - excel VBA - 从函数中重新获得可变长度数组

javascript - 存储高分 JavaScript

php - 使用 MySQL 和 PHP 无法保存图像名称,而图像名称具有 `+` 符号

vb.net - 如何实例化 vba 类并调用 vb.net 中的方法?

excel - Word for Mac - 调用 Excel.Application.Workbooks.Open 时出错 运行时错误 -2146959355 (80080005)

c++ - VBA 调用 C++ DLL - 错误 48(找不到文件)