mougに「マクロでJPEG画像のExif(Orientation)を書き換えたい」という質問(https://www.moug.net/faq/viewtopic.php?t=78227)がありました。
標準機能では処理できなさそうだったので、軽い気持ちでExifの回転情報について調べてみましたが、即断念。
- JPEGファイルのバイナリからExifが読めるようになるまでに見たサイト
- http://ryu-htn.hatenablog.com/entry/2017/11/30/024820
- iPhoneからアップロードしたJPEG写真が横向きになる問題(EXIF, Orientation) – Qiita
- https://qiita.com/RichardImaokaJP/items/385beb77eb39243e50a6
- Exifの回転情報をピクセル情報に反映する – Qiita
- https://qiita.com/minodisk/items/b7bab1b3f351f72d534b
- JPEG画像のEXIF情報を修正して写真の表示の向きを直す
- https://at.sachi-web.com/blog-entry-804.html
リンクを辿ってこのサイトとか見てみましたが、これは無理。
バイナリから攻めるのは早々に諦めます。
.NetだとEncoder.Transformationで比較的簡単に変更できるようですが(「EXIFの情報に基づいて画像を回転する」参考)、画像の再保存となるので画質的にはあまり好ましくありません。
「F6 Exif」のようなExifの編集ツールを使えば、画質を損なうことなく回転情報を変更できますが、それだともはやマクロを使う必要すらなくなってしまいます。
というわけで、別の方向からのアプローチとして、エクスプローラーの「向き」情報を変更する方法を調べてみたところ、Windows Vista以降であれば、IPropertyStore経由で何とかできそうなことが分かりました。
(エクスプローラーの「向き」=ExifのOrientation、なのかどうかは未確認ですが、この際置いておきます。)
とはいえ、VBAからの処理はどう考えてもキツそうです・・・。
- C# Jpegの件名とコメントを編集して、エクスプローラで確認できるように書き換えたい – スタック・オーバーフロー
- https://ja.stackoverflow.com/questions/17098/
- ファイルの属性の変更について
- https://social.msdn.microsoft.com/Forums/ja-JP/csharpgeneralja/thread/bfe35aef-583e-4a53-a74e-cb880ea69f4d
- Windows7における作成日時の変更方法について
- https://social.msdn.microsoft.com/Forums/ja-JP/vcgeneralja/thread/1717ff79-11ae-4aa4-b793-0720de003484
- 「C# 画像ファイルのプロパティ情報(Vista)」(1) Insider.NET - @IT
- https://www.atmarkit.co.jp/bbs/phpBB/viewtopic.php?topic=41344&forum=7
そこでさらにググったところ、海外のフォーラムでタイプライブラリ(oleexp.tlb)を作ってくださっている方を見つけました。
良さげなサンプルコードもあるし、もうこれで良いじゃん!
サンキュー!VBForums!!
というわけで、以下コードです。
'oleexp.tlb要参照 ' http://www.vbforums.com/showthread.php?786079-VB6-Modern-Shell-Interface-Type-Library-oleexp-tlb#dloleexp '下記コード参考 ' http://www.vbforums.com/showthread.php?803855-Vista-Code-Snippet-Get-and-set-the-Rating-(stars)-of-a-file Option Explicit Private Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long Private Declare Function SHCreateItemFromIDList Lib "shell32" (ByVal pidl As Long, riid As UUID, ppv As Any) As Long Private Declare Sub ILFree Lib "shell32" (ByVal pidl As Long) 'System.Photo.Orientation ' https://docs.microsoft.com/en-us/windows/desktop/properties/props-system-photo-orientation Public Enum PKEY_Photo_Orientation PHOTO_ORIENTATION_NORMAL = 1 '標準(Normal) PHOTO_ORIENTATION_FLIPHORIZONTAL = 2 '左右反転(Flip horizontal) PHOTO_ORIENTATION_ROTATE180 = 3 '180度回転(Rotate 180 degrees) PHOTO_ORIENTATION_FLIPVERTICAL = 4 '上下反転(Flip vertical) PHOTO_ORIENTATION_TRANSPOSE = 5 '転置(Transpose) PHOTO_ORIENTATION_ROTATE270 = 6 '270度回転(Rotate 270 degrees) PHOTO_ORIENTATION_TRANSVERSE = 7 '横置き(Transverse) PHOTO_ORIENTATION_ROTATE90 = 8 '90度回転(Rotate 90 degrees) End Enum Public Sub Sample() Dim img As String: img = "C:\Test\Picture\kuma.jpg" With CreateObject("Scripting.FileSystemObject") Select Case LCase(.GetExtensionName(img)) Case "jpg", "jpeg" Case Else: Exit Sub End Select End With SetFileOrientation img, PHOTO_ORIENTATION_FLIPVERTICAL End Sub Public Function SetFileOrientation(ByVal sFile As String, ByVal lRotation As PKEY_Photo_Orientation) As Long Dim vvar As Variant Dim isi As IShellItem2 Dim pidlFile As Long Dim pps As IPropertyStore Dim hr As Long Dim pkOrientation As PROPERTYKEY '{14B81DA1-0135-4D31-96D9-6CBFC9671A99}, 274 DEFINE_PROPERTYKEY pkOrientation, &H14B81DA1, CInt(&H135), CInt(&H4D31), &H96, &HD9, &H6C, &HBF, &HC9, &H67, &H1A, &H99, 274 vvar = CVar(lRotation) pidlFile = ILCreateFromPathW(StrPtr(sFile)) Call SHCreateItemFromIDList(pidlFile, IID_IShellItem2, isi) isi.GetPropertyStore GPS_READWRITE, IID_IPropertyStore, pps hr = pps.SetValue(pkOrientation, vvar) 'returns S_OK if successful If hr = 0 Then hr = pps.Commit 'save the changes; returns S_OK if successful Set pps = Nothing Set isi = Nothing Call ILFree(pidlFile) 'always set your pidl free! SetFileOrientation = hr End Function Public Sub DEFINE_PROPERTYKEY(Name As PROPERTYKEY, L As Long, w1 As Integer, w2 As Integer, B0 As Byte, b1 As Byte, b2 As Byte, B3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte, pid As Long) With Name.fmtid .Data1 = L .Data2 = w1 .Data3 = w2 .Data4(0) = B0 .Data4(1) = b1 .Data4(2) = b2 .Data4(3) = B3 .Data4(4) = b4 .Data4(5) = b5 .Data4(6) = b6 .Data4(7) = b7 End With Name.pid = pid End Sub Public Sub DEFINE_UUID(Name As UUID, L As Long, w1 As Integer, w2 As Integer, B0 As Byte, b1 As Byte, b2 As Byte, B3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte) With Name .Data1 = L .Data2 = w1 .Data3 = w2 .Data4(0) = B0 .Data4(1) = b1 .Data4(2) = b2 .Data4(3) = B3 .Data4(4) = b4 .Data4(5) = b5 .Data4(6) = b6 .Data4(7) = b7 End With End Sub Public Function IID_IShellItem2() As UUID '7e9fb0d3-919f-4307-ab2e-9b1860310c93 Static iid As UUID If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H7E9FB0D3, CInt(&H919F), CInt(&H4307), &HAB, &H2E, &H9B, &H18, &H60, &H31, &HC, &H93) IID_IShellItem2 = iid End Function Public Function IID_IPropertyStore() As UUID 'DEFINE_GUID(IID_IPropertyStore,0x886d8eeb, 0x8cf2, 0x4446, 0x8d,0x02,0xcd,0xba,0x1d,0xbd,0xcf,0x99); Static iid As UUID If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H886D8EEB, CInt(&H8CF2), CInt(&H4446), &H8D, &H2, &HCD, &HBA, &H1D, &HBD, &HCF, &H99) IID_IPropertyStore = iid End Function
oleexp.tlbをダウンロードして参照する必要がありますが、おかげさまで思ったより短いコードになりました。
しかしながら「oleexp.tlb」はすごい!
どれだけのインターフェースをサポートしてるんだ!?コレ。
この記事へのコメントはありません。