食っちゃ寝システムができるまで

「食っちゃ寝システム」ができるまでの、棚卸&備忘録です。

「食っちゃ寝システム第一弾」(5):写真Exif編集アプリver500(3)

「食っちゃ寝システム第一弾」(5):中間報告

 

②写真のExif情報確認/編集

写真Exif編集アプリver500は読出した写真をExif情報確認/編集機能つけました

 

f:id:taikobox:20181209163344p:plain

 

1)プログラムの動作説明

f:id:taikobox:20181209163430p:plain

ここに関しては、練習用にWIAを使ってみました。

WIA=Windows Image Acquisition

直訳通り、ウィンドウズのイメージ取得用のオブジェクトで

歴史は意外に古くWindowsME(2000年から)ある機能です

Wia object - Windows applications | Microsoft Docs

Windows Image Acquisition - Wikipedia

niwakan.blogspot.com

 

 使う前の準備として、先にVBAエディタからツール⇒参照設定

Windows Image Acquisitionにチェック入れてください

f:id:taikobox:20181209164048p:plain

 

尚、Exif編集に関しては、今回は自分で作らず。フリーウェア「F6Exif」をコマンドラインで値渡し起動させることで一応対応しています。(縮小専用を外部操作するのと同じ手法です)そのため事前にF6Exif.exeを同一フォルダに格納しています
*コードとしては以下の部分で対応しています
 Res = Shell(ThisWorkbook.Path & "\F6Exif.exe" & ExifTarget, vbNormalFocus)

Exif確認編集部のコード>

===========================================

 

 


Private Sub Exif_Com1_Click()
Dim MapURL As String
MapURL = "https://www.google.co.jp/maps/@" & ExifModify.Exif_info3 & "," & ExifModify.Exif_info4 & ",72m/data=!3m1!1e3"
Call IEOpen(MapURL)
End Sub

Private Sub Exif_Com2_Click()
Dim ckExifEdit, ckExif_Camera, ckExif_Date, ckExif_Lat, ckExif_Lon, ckExif_Rotate
Dim overwriteExif

'Exif情報 変更ある場合は変更後⇒exif情報読込
ckExifEdit = ExifModify.Exif_edit1.Value & ExifModify.Exif_edit2.Value & ExifModify.Exif_edit3.Value & ExifModify.Exif_edit4.Value & ExifModify.Exif_edit5.Value
If (ckExifEdit = "") Then
'そのままexif情報読込
Else
'Exiftool通じて上書き
If (ExifModify.Exif_edit2.Value <> "") Then
Exiftooldate = " " & "-overwrite_original -MediaCreateDate='" & Exif_info2 & "' " & "-MediaModifyDate='" & ExifModify.Exif_edit2.Value & "' " & ExifModify.Exif_Path
End If


On Error Resume Next
MsgBox Exiftooldate
overwriteExif = Shell(ThisWorkbook.Path & "\exiftool.exe" & Exiftooldate, vbNormalFocus)
MsgBox overwriteExif
If Err.Number Then
MsgBox "Exiftool使えない環境です。別途Exif読取君開いてください。(変更内容に制限あります)"
Exit Sub
End If
On Error GoTo 0

End If

Call GetExifinfo

End Sub

Private Sub Exif_Com3_Click()
Unload ExifModify
End Sub

Private Sub Exif_Import_Click()
If (ExifModify.Exif_Path = "") Then

End If

ExifModify.Exif_Image.Picture = LoadPicture(FilePath)
End Sub

Private Sub Exif_Path_Click()
Dim LoadFile As String
Dim GetFilePath As String
LoadFile = MsgBox("新規ファイル読込みます", vbYesNo)
If (LoadFile = vbNo) Then
Exit Sub
Else
ChDir ActiveWorkbook.Path
GetFilePath = Application.GetOpenFilename _
("jpg画像,*.jpg;*.jpeg", , "画像の選択", , False)
End If
ExifModify.Exif_Path = GetFilePath
ExifModify.Exif_Image.Picture = LoadPicture(GetFilePath)
Call GetExifinfo
End Sub
Sub GetExifinfo()
Dim ObjWIA As Object '情報読込にはWIAライブラリを使用する
'初期化
ExifModify.Exif_info1 = ""
ExifModify.Exif_info2 = ""
ExifModify.Exif_info3 = ""
ExifModify.Exif_info4 = ""
ExifModify.Exif_info5 = ""

If (ExifModify.Exif_Path = "") Then
Exit Sub
End If
If (Dir(ExifModify.Exif_Path, vbDirectory) = "") Then
MsgBox "ファイルがありません"
Exit Sub
End If

Set ObjWIA = CreateObject("Wia.ImageFile")
ObjWIA.LoadFile ExifModify.Exif_Path

On Error Resume Next
For Each p In ObjWIA.Properties
i = i + 1
V_ID = p.PropertyID

If p.PropertyID = 2 Then
ExifModify.Exif_info3 = p.Value(1) + p.Value(2) / 60 + p.Value(3) / 3600 'ID=2=緯度
ElseIf p.PropertyID = 4 Then
ExifModify.Exif_info4 = p.Value(1) + p.Value(2) / 60 + p.Value(3) / 3600 'ID=4=経度
ElseIf p.PropertyID = 272 Then
ExifModify.Exif_info1 = p.Value 'ID=272=カメラ型番
ElseIf p.PropertyID = 274 Then
ExifModify.Exif_info5 = p.Value 'ID=274=回転方向
ElseIf p.PropertyID = 36867 Then
ExifModify.Exif_info2 = p.Value 'ID=36867=撮影時間
End If

Next
On Error GoTo 0

Set ObjWIA = Nothing
End Sub

Private Sub OpenApp_Click()
Dim ExifTarget


On Error Resume Next
'この例ではBookと同じフォルダにShukuSen.exeがあります。
ExifTarget = " " & ExifModify.Exif_Path.Caption

Res = Shell(ThisWorkbook.Path & "\F6Exif.exe" & ExifTarget, vbNormalFocus)
If Err.Number Then
MsgBox "error"
Exit Sub
End If
On Error GoTo 0
End Sub

Private Sub UserForm_Initialize()
With ExifModify.Exif_edit5
.AddItem "1"
.AddItem "2"
.AddItem "3"
.AddItem "4"
.AddItem "5"
.AddItem "6"
.AddItem "7"
.AddItem "8"
.Value = ""
End With
Call Exif_Com2_Click

End Sub

 ====================================================

 

 ⇒写真Exif編集アプリver500(4)