スキルアップ・問題解決なら、モーグにおまかせ！

現在，画像の管理をエクセルで行っているのですが，
Windows8以降だとアイコン表示が，Exif情報を利用して，
自動的に縦表示等に変わります．Windows7だと自動回転しないので，
問題なかったのですが，これからWindows10に変更するのに困ってます．
ExifのPropertyID "274" Orientationの値で制御されてるようですが，
今回，この値を"1"に統一できないかと考えてます．
色々調べてみて，WIA.ImageFileでExif情報の値を取得するのはできたのですが，
値を変更する方法が今ひとつわかりません．
多分，バイナリーモードで開いて変更するのでは無いかと予想していますが，
そういうことをやったことが無いので，現在頓挫しております．
ご助言のほどよろしくお願いします．
 
以下，書き出しまでのコードです．
 
Private Sub test1() 'jpgのExifデータをシートに書き出す
Dim xf As Object 'WIA.ImageFile
Dim Prop As Variant
Dim i As Integer
Set xf = CreateObject("Wia.ImageFile")
xf.LoadFile ThisWorkbook.Path & "\test.jpg"
 
Application.ScreenUpdating = False
Cells.ClearContents
On Error Resume Next
 
i = 0
For Each Prop In xf.Properties
    i = i + 1
    If Prop.PropertyID = "274" And Prop.Value <> "1" Then
        'ここの処理がわかりません
        '
    End If
    Cells(i, 1).Value = Prop.PropertyID
    Cells(i, 2).Value = Prop.Name
    Cells(i, 3).Value = Prop.Value
Next
On Error GoTo 0
Range("1:3").EntireColumn.AutoFit
Application.ScreenUpdating = True
Set xf = Nothing
 
End Sub

PropertyID 274
は、
必ず4番目だから、ループして探さなくても決め打ちでもいいと思います。
 

Sub test1()
    Dim xf As IImageFile    'WIA.ImageFile
    Set xf = CreateObject("Wia.ImageFile")
    xf.LoadFile ThisWorkbook.Path & "\test.jpg"
    If xf.Properties(4).Value > 1 Then
        xf.Properties(4).Value = 1
    End If
    Set xf = Nothing
End Sub

mattuwan44さん
ご返事ありがとうございます．
私も，Prop.Value = "1" として，直接書き換える方法を試してはみましたが，
上手く書き換えられませんでした．
 
>Exifを見ると変わっているけど、
とのことですが，
一応確認できるように，今回リストを書き出すコードにしてますが，
私の環境では書き換えられてないようです．
 
フリーソフトも考えましたが，写真を格納しているフォルダが，
100個以上有って，それぞれに多いものでは数十枚のjpegファイルがあるので，
VBAの勉強も含めて考えています．
 
引き続きよろしくお願いします．

お望みの回答ではないですがコメントします。
 
とても難しいですね。
まず、Wia.ImageFileを利用したImageFileオブジェクトの操作では、
Orientationプロパティの更新はできないと思います。
 
というのは、下記に記載があるように
https://docs.microsoft.com/en-us/previous-versions/windows/desktop/wiaaut/-wiaaut-imagefile
PropertiesはRead-Onlyとなっています。
ローカルウインドウでも、IsReadOnlyにTrueが建っています。
（私の環境では、実際に、値をセットしようとるすると、「アクセスが拒否されました」となりました。）
 
となると、Wia.ImageFileを使わずにバイナリファイルとして読み込んで操作することになるのでしょうけど、
どなたかから回答があるとよいですね。
 
なお、フリーソフト
https://www.vector.co.jp/soft/winnt/art/se506385.html
でフォルダ内の全ファイルに対して一括してOrientationが変更できるようです。
・対象となるフォルダたちを、ひとつにまとめるマクロと
・それらを元に戻すマクロ
は簡単でしょうから、このフリーソフトを使うのが最小コストで済みそうですね。

 
VBAにはできることに限界があります。
また、お望みのことはC#などでも困難みたいです。
 
もしVBAて実現させるならご指摘のようにバイナリ編集になりますが
その前にどの位置を書き換えるかを知る必要かあります。その場所は
 
Exif規格
http://www.cipa.jp/std/documents/j/DC-008-2012_J.pdf
 
の171ページ にあります。しかし、Exif規格を理解しなければ、
その位置や値は特定できません。
 
もちろんExif規格を完全に理解すれば可能ですが。
 
 

simpleさん，MMYSさん
コメントありがとうございます．
参考になります．やはり難しいですよね．
 
とりあえずもう少し挑戦してみて，駄目ならばあきらめて，
ご紹介が有ったソフト等も検討します．
 
Stirlingなどでバイナリーを開いて眺めてみます．
皆様色々ありがとうございました．
当スレは，もう少し開いておきます．
何か報告ができるといいかなと思ってます．
[/quote]

WIA.ImageFileというのは初めて知りました。
私も試してみたのですが、変更できませんでした。
それでGDIPlusで変更するものを作成してみました。
画像の向きを指定する数値と出来た画像のExplorer上の向きを見て混乱しましたが、
Exifの数値は画像が指定された向きであるという情報を付与するものであり、
Explorer上の向きは画像に指定した向きで表示するという意味と解釈しました。
(Exifの90度回転は情報がない画像は90度回転されているので情報を付与すると270度回転して表示する)
どちらにしても今回の場合は標準に戻すのでRotateNoneFlipNoneで良いかと思います。
 

Option Explicit
Private Declare PtrSafe Function GdiplusStartup Lib "gdiplus" _
    (ByRef token As LongPtr, _
     ByVal input_ As LongPtr, _
     Optional ByVal output_ As LongPtr) As Long
Private Declare PtrSafe Sub GdiplusShutdown Lib "gdiplus" _
    (ByVal token As LongPtr)
Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "gdiplus" _
    (ByVal filename_ As LongPtr, _
     ByRef bitmap_ As LongPtr) As Long
Private Declare PtrSafe Function GdipDisposeImage Lib "gdiplus" _
    (ByVal image_ As LongPtr) As Long
Private Declare PtrSafe Function GdipGetPropertyItemSize Lib "gdiplus" _
    (ByVal Image As LongPtr, _
    ByVal propID As Long, _
    ByRef lngSize As Long) As Long
Private Declare PtrSafe Function GdipGetPropertyItem Lib "gdiplus" _
    (ByVal Image As LongPtr, _
    ByVal propID As Long, _
    ByVal propSize As Long, _
    ByRef buffer As Any) As Long
Private Declare PtrSafe Function GdipSetPropertyItem Lib "gdiplus" _
    (ByVal nImage As LongPtr, _
    item As PropertyItem) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As LongPtr)
Private Declare PtrSafe Function GdipSaveImageToFile Lib "gdiplus" ( _
        ByVal Image As LongPtr, _
        ByVal FileName As LongPtr, _
        ByRef clsidEncoder As GUID, _
        ByVal encoderParams As Long) As Long
Private Declare PtrSafe Function CLSIDFromString Lib "ole32.dll" ( _
        ByVal lpszCLSID As LongPtr, _
        ByRef pCLSID As GUID) As Long

'プロパティ
Private Type PropertyItem
    id As Long
    Length As Long
    Type As Integer
    Value As LongPtr
End Type

Private Type GdiplusStartupInput
    GdiplusVersion As Long
    dummy1 As LongPtr
    dummy2 As Long
    dummy3 As Long
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

'付与する画像の向き
Private Enum RotateFlipType
    RotateNoneFlipNone = 1
    RotateNoneFlipX = 2
    Rotate180FlipNone = 3
    Rotate180FlipX = 4
    Rotate90FlipNone = 6
    Rotate90FlipX = 5
    Rotate270FlipNone = 8
    Rotate270FlipX = 7
End Enum

Private Const PropertyTagOrientation  As Long = &H112&  '画像の方向
Private Const PropertyTagTypeShort = 3

Private Const GUID_ENCODER_BMP = "{557CF400-1A04-11D3-9A73-0000F81EF32E}"
Private Const GUID_ENCODER_JPG = "{557CF401-1A04-11D3-9A73-0000F81EF32E}"
Private Const GUID_ENCODER_GIF = "{557CF402-1A04-11D3-9A73-0000F81EF32E}"
Private Const GUID_ENCODER_TIF = "{557CF405-1A04-11D3-9A73-0000F81EF32E}"
Private Const GUID_ENCODER_PNG = "{557CF406-1A04-11D3-9A73-0000F81EF32E}"

Sub test()
    
    Dim strFileIn As String
    Dim strFileOut As String
    
    strFileIn = ThisWorkbook.Path & "\test.jpg"
    strFileOut = Left(strFileIn, InStrRev(strFileIn, ".") - 1) & "_" & Mid(strFileIn, InStrRev(strFileIn, "."))
    
    '画像の向きを標準に
    ChangeRotateedTagToImgFile strFileIn, strFileOut, RotateNoneFlipNone
    
End Sub
'画像に回転情報を追加する
Private Sub ChangeRotateedTagToImgFile(strFileIn As String, strFileOut As String, enmRot As RotateFlipType)

    Dim gpStartupInput As GdiplusStartupInput
    Dim lngToken As LongPtr      'トークン
    Dim pBm As LongPtr
    Dim lngRet As Long
    Dim uid As GUID
    Dim pItm As PropertyItem
    Dim buff() As Byte
    Dim lngSize As Long
    Dim intOrientation As Integer
    
    On Error GoTo ErrHDL
    
    '初期化とBitmapオブジェクト取得
    gpStartupInput.GdiplusVersion = 1
    lngRet = GdiplusStartup(lngToken, VarPtr(gpStartupInput))
    lngRet = GdipCreateBitmapFromFile(StrPtr(strFileIn), pBm)
    
    '回転情報をPropertyItemに取得(回転情報がなくても変更する場合はコメントアウト
'    '取得プロパティサイズ
'    lngRet = GdipGetPropertyItemSize(pBm, PropertyTagOrientation, lngSize)
'    If lngSize = 0 Then
'        GoTo ErrHDL
'    End If
'    ReDim buff(lngSize - 1) As Byte
'
'    'プロパティをバイト配列へ
'    lngRet = GdipGetPropertyItem(pBm, PropertyTagOrientation, lngSize, buff(0))
'
'    'バイト配列からPropertyItem型へ
'    Call CopyMemory(pItm, buff(0), LenB(pItm))

    '回転情報をPropertyItemに設定(回転情報を元に変更する場合はコメントアウト)
    pItm.id = PropertyTagOrientation
    pItm.Length = 2  'Shortで2バイト
    pItm.Type = PropertyTagTypeShort
    pItm.Value = VarPtr(pItm) + LenB(pItm) 'PropertyItemの次に実際のValueが配置
    
    '画像の向きを付与
    intOrientation = enmRot
    Call CopyMemory(ByVal pItm.Value, intOrientation, LenB(intOrientation))
    
    'プロパティを画像に適用
    lngRet = GdipSetPropertyItem(pBm, pItm)
    
    'GUID
    lngRet = CLSIDFromString(StrPtr(GUID_ENCODER_JPG), uid)
        
    '画像をファイルに書き出し
    lngRet = GdipSaveImageToFile(pBm, StrPtr(strFileOut), uid, 0)
    
ErrHDL:
    
    'Bitmapオブジェクト破棄と終了
    lngRet = GdipDisposeImage(pBm)
    GdiplusShutdown lngToken

End Sub

baooさん ありがとうございます．ご返事遅くなりました．
GDI+とか考えたことも無いので，あまりにもすごすぎて，
未だに良く理解できないで居ます．Exif情報だけじゃ無く，
画像の回転まで考慮してあるんですね．
もう少し勉強が必要みたいですが，利用させていただきたいと思います．
 
今まで自分なりに検討した結果を書いてみます．
Exif情報の構造について勉強してみました．
 
自分のJPGファイルの最初の部分です．22バイト．
FF D8 FF E1 FF FE 45 78 69 66 00 00 4D 4D 00 2A 00 00 00 08 00 0A
結局，Exif情報に行き着くためには，「4D 4D」(ビッグエンディアン)と
最後の方の「00 00 00 08」(オフセット)で決まるようです．
この情報だと，最初の4Dからみて8バイト目からExif情報が始まります．
Exif情報の始まりの2バイト(上記最後の2バイト)，
「00 0A」がExifの最初にあるタグ数なので，
上記情報で10個のタグがあることがわかります．
それぞれのタグ情報は12バイト1組のデータで，Orientationは3つめのタグなので，
Orientationに行き着くまでに，24バイトのデータ(メーカーとモデル名)があります．
JPGのOrientationのタグの内容は，以下のようになっています．
01 12 00 03 00 00 00 01 00 06 00 00
左から2バイト 2バイト 4バイト 4バイトの要素の組になっていて，
最後の要素の組4バイトのはじめの2バイト「00 06」がOrientationの値です．
結果的には，この06→01に変更すればいいので，そこまでのバイト数を数えると，
22+24+10=56バイト目というのがわかりました．
ただし，「49 49」(リトルエンディアン)の場合は，55バイト目になるようです．
 
以上わかったようなことを書きましたが，
ビッグエンディアンという言葉すら聞いたことの無い，
素人に毛が生えたくらいのレベルなので，
今は，JPGの先頭部分の100バイトぐらいを読んで，
55バイト目か56バイト目が2以上であれば，1に書き換えようと目論んでいました．
ただ，JPGの先頭部分だけを読み込んで書き換える方法が
よくわからなくて，また頓挫しております．
まあ，ファイル全体を読み込めばできそうなんですけど，
何となく，もう少し安直に出来ないかなあと思っているところです．
 
このやり方だと，最初のオフセットが8より大きいと上手くいかず，
その場合は，エンディアンを判別して，オフセットの並びから，
オフセットを計算して，何バイト目を書き換えるかで
汎用性を持たせることが出来ると思います．
ただし今回の対象JPGファイルは，単一のカメラで撮影したものなので，
簡便な方法でもいいような気がしています．
 
以上現状です．
 
baooさん とりあえずお礼まで．

norinorih さんの引用:
自分のJPGファイルの最初の部分です．22バイト．
FF D8 FF E1 FF FE 45 78 69 66 00 00 4D 4D 00 2A 00 00 00 08 00 0A
結局，Exif情報に行き着くためには，「4D 4D」(ビッグエンディアン)と
最後の方の「00 00 00 08」(オフセット)で決まるようです．

Option Explicit
Private Enum RotateFlipType
    RotateNoneFlipNone = 1
    RotateNoneFlipX = 2
    Rotate180FlipNone = 3
    Rotate180FlipX = 4
    Rotate90FlipNone = 6
    Rotate90FlipX = 5
    Rotate270FlipNone = 8
    Rotate270FlipX = 7
End Enum
Sub test2()
    
    Dim strFile As String
    strFile = ThisWorkbook.Path & "\test.jpg"
    ChangeRotateedTagToImgFile2 strFile, RotateNoneFlipNone
    
End Sub

Private Sub ChangeRotateedTagToImgFile2(strFile As String, enmRot As RotateFlipType)

    Dim lngFN As Long
    Dim lngAddress As Long
    Dim lngSize As Long
    Dim blIntel As Boolean
    Dim lngNumIFD As Long
    Dim i As Long
    Dim bt() As Byte
    
    On Error GoTo ErrHDL
    
    lngFN = FreeFile
    
    Open strFile For Binary As #lngFN
    ReDim bt(10) As Byte
    Get #lngFN, 1, bt
    
    'SOIチェック
    If bt(0) <> &HFF Or bt(1) <> &HD8 Then
        GoTo ErrHDL
    End If
    
    'APP1のアドレスとサイズを取得
    lngAddress = 3
    Do While Not EOF(lngFN)
        ReDim bt(3) As Byte
        Get #lngFN, lngAddress, bt
        If bt(0) = &HFF Then
            'セグメントのサイズ
            lngSize = bt(2) * 256& + bt(3)
            
            'APP1だったら抜け、APP1でなかったら次のセグメント
            If bt(1) = &HE1 Then
                Exit Do
            Else
                lngAddress = lngAddress + 2 + lngSize
            End If
        Else
            'APP1が見つからなかったら終了
            GoTo ErrHDL
        End If
    Loop
    
    '改めてAPP1全データを配列に格納
    ReDim bt(lngSize + 1) As Byte
    Get #lngFN, lngAddress, bt
    
    'Exifチェック
    If bt(4) <> &H45 Or bt(5) <> &H78 Or bt(6) <> &H69 Or bt(7) <> &H66 Then
        GoTo ErrHDL
    End If
    
    'エンディアンチェック
    If bt(10) = &H49 And bt(11) = &H49 Then
        blIntel = True
    ElseIf bt(10) = &H4D And bt(11) = &H4D Then
        blIntel = False
    Else
        GoTo ErrHDL
    End If
    
    If blIntel = True Then
        lngNumIFD = bt(18) + bt(19) * 256&  'タグの数
        For i = 0 To lngNumIFD - 1
            If bt(20 + i * 12 + 1) = &H1 And bt(20 + i * 12) = &H12 Then    'IFD112
                bt(20 + i * 12 + 8) = enmRot   'IFD112の値は2バイトで8バイト目から始まる(0X 00)
                Put #lngFN, lngAddress, bt  '書き込み
            End If
        Next i
    Else
        lngNumIFD = bt(18) * 256& + bt(19)  'タグの数
        For i = 0 To lngNumIFD - 1
            If bt(20 + i * 12) = &H1 And bt(20 + i * 12 + 1) = &H12 Then    'IFD112
                bt(20 + i * 12 + 9) = enmRot   'IFD112の値は2バイトで8バイト目から始まる(00 0X)
                Put #lngFN, lngAddress, bt  '書き込み
            End If
        Next i
    End If

ErrHDL:

    Close #lngFN

End Sub

baooさん ありがとうございます．ご返事遅くなりました．
 

引用:
JPEGファイルによってはそのようになるとは限りません。
  
JPEGファイルは先頭にSOIマーカー(FF D8)と呼ばれる2バイトで始まりますが、
それ以降は複数のセグメントと呼ばれる領域になります。
この中からExif情報を示すAPP1(FF E1で始まる)マーカーから始まるセグメントを探す必要があります。
norinorihさんのJPGファイルの場合は3バイト目がそれにあたります。
しかしその画像をMSPaintで開いてから別名で保存してみてください。
そうすると恐らく3バイト目からはFF E0に変わると思います。(APP0セグメント)
そして21バイト目からFF E1で始まるAPP1セグメントが見つかると思います。