Excel VBA でリンク貼り付けする写真の縦横判断（ Exif 利用）

Exif 情報を利用して Excel で写真のリンク貼り付けを正確に判断する

Excel VBA で Pictures.Insert() を利用して写真のリンク貼り付けを行おうとした場合、なぜか縦で撮影した写真の縦横が正確に判定されない現象がありました。
リンク貼り付けは多くの画像を貼り付ける必要があるが Excel ファイル自体のファイルサイズを大きくしたくないため利用していたが、写真の縦横判別がうまくいかない場合の解決方法としてほとんどが AddPicture() を利用して貼り付ける、もしくは一度貼ってから判断等の方法しかなかったため、 Exif 情報を利用して判断できないか検討したのがこの方法です。
ちなみに Exif 情報の取得のため参考にしたサイトは以下です。

実際のコード

Sub photoChk()
    Dim ws As Worksheet
    Dim Filename As String
    Dim Orientation As Integer
    Dim objWia As Object, p As Object

    Set ws = ActiveSheet
    
    ' 写真をリンク貼り付け
    Filename = "C:\Users\user1\Pictures\サンプル写真\photo001.jpg"

    ' 写真の Orientation で縦横判定
    Orientation = 0
    Set objWia = CreateObject("Wia.ImageFile")
    objWia.LoadFile Filename
    For Each p In objWia.Properties
        If p.Name = "Orientation" Then
            Orientation = p.Value
            Exit For
        End If
    Next

    ' リンク貼り付け処理
    ws.Cells(1, 1).Select
    With ws.Pictures.Insert(Filename)
        If Orientation <= 1 Then
            .Height = Application.CentimetersToPoints(3.25)
        Else
            .Width = Application.CentimetersToPoints(3.25)
        End If
    End With
End Sub

説明

上記コードは最低限の部分のみ抜粋していることと、例えば iPad 等で右側を下とした場合、左側を下とした場合、逆さに撮影した場合等も含めて正確に判定しようと思ったらもう少し詳細に記述する必要があるかと思われます。また、実際に貼り付ける写真サイズの指定も適度な物なので環境に合わせてください。

Excel VBA の基本的な部分は省いて、まずはImageFileオブジェクトを取得します。

Set objWia = CreateObject("Wia.ImageFile")

次に取得したいファイルの URL から画像ファイルをロードします。

objWia.LoadFile Filename

ここまでは参考リンクにある通りですが、今回必要なのは Orientation と呼ばれる Exif 情報の中の回転情報だけなので、ループで安易に取り出してしまいます。
見た限り Object の Item 3 が Orientation のようなので直接objWia.Properties.Item(3).Valueしてもいい気がしますが、 Exif 情報の同じ位置に必ず Orientation があるのか分からないので直接取得は行っていません。分かる方誰か教えてくださいm(__)m

Exif 情報の中の Orientation 内の説明としては以下の情報を参考にしています。

実際の Exif 情報の中身はこんな感じ

画像方向となっている箇所が回転の向きで、この写真の場合数字で言えば 8 です。

For Each p In objWia.Properties
    If p.Name = "Orientation" Then
        Orientation = p.Value
        Exit For
    End If
Next

今回は Orientation 情報のうち Default が 1 であることと、 Exif 情報がない（削除されてた）場合に 0 となることを考慮して 1 以上の場合には回転処理があるものとして処理を行っています。回転方向で処理が異なる必要がある場合にはこの数値をキーとして分岐してください。

With ws.Pictures.Insert(Filename)
    If Orientation <= 1 Then
        .Height = Application.CentimetersToPoints(3.25)
    Else
        .Width = Application.CentimetersToPoints(3.25)
    End If
End With

具体的には Orientation が Default の場合横写真、もしくは Excel 上で回転が認識できている写真として高さを変更しています。回転画像の場合 Excel は横方向が高さだと誤認識するため幅を変更することで高さを合わせています。

おまけ

Excel VBA から PowerPoint に写真を貼り付ける場合にも同様の問題が発生します。これはAddPicture() を利用した場合でも縦写真が横向きに貼り付けられてしまいます。縦横の長さで判定しても横方向を高さだと認識しているので正常に判断できません。
これも Exif 情報を判断して貼り付けを行ってみます。

実際のコード

Sub picPPT()
    Dim ws As Worksheet
    Dim ppApp As New PowerPoint.Application
    Dim ppPrs As PowerPoint.Presentation
    Dim ppSld As PowerPoint.Slide
    Dim Filename As String
    Dim Orientation As Integer
    Dim pic As Object, objWia As Object, p As Object

    Set ws = ActiveSheet
    
    Set ppPrs = ppApp.Presentations.Open(Filename:=ThisWorkbook.Path & "\test.pptx", Untitled:=msoTrue)
    Set ppSld = ppPrs.Slides(1)
    
    ' 写真を PowerPoint に貼り付け
    Filename = "C:\Users\user1\Pictures\サンプル写真\photo001.jpg"
    Set pic = LoadPicture(Filename)
    Set objWia = CreateObject("Wia.ImageFile")
    objWia.LoadFile Filename
    
    ' 写真の回転方向を取得
    For Each p In objWia.Properties
        If p.Name = "Orientation" Then
            Orientation = p.Value
        Exit For
        End If
    Next
    
    If Orientation = 1 And pic.Width > pic.Height Then
        ' 横長写真
        ppSld.Shapes.Placeholders(1).Width = 226.75
        ppSld.Shapes.Placeholders(1).Height = 170
        Set picture = ppSld.Shapes.AddPicture(Filename, True, True, 0, 0)
    Else
        ' 縦長写真
        ppSld.Shapes.Placeholders(1).Width = 148.75
        ppSld.Shapes.Placeholders(1).Height = 198.38
        ppSld.Shapes.Placeholders(1).Left = 85
        Set picture = ppSld.Shapes.AddPicture(Filename, True, True, 0, 0)
    End If

End Sub

説明

一部コードは Excel 貼り付けと同じなので、縦横判定部分だけ説明します。

If Orientation = 1 And pic.Width > pic.Height Then

Exif 情報の Orientation が 1 （ Default ）でかつ読み込んだ写真の横が縦より長い場合は横向き写真と判定しています。それ以外を縦向き写真として判定して処理しています。