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

現在，画像の管理をエクセルで行っているのですが，
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