btinc.jp 発表会演目一覧
演目1. デジカメJPEGファイルのExif情報を読み取る Excel 2003

私のデジカメは今世紀初頭の製品で少々古い。電池を充電のために取りはずすと日付がリセットされてしまうので、充電後初めてシャッターを開けた時には「日付設定をしてください」というメッセージにしたがって設定を行うのだが、時刻は間違えないくせに日付をよく間違える。一日出歩いて撮りためたJPEGファイルをパソコンに移したときにやっと気づく。
ファイルの更新日付はともかく、撮影日付の訂正はExif情報を書き換えるしかなくネットでExifフォーマットを調べ、こういうバイナリ操作はCでなければだめと思い込み慣れないC言語で撮影日付訂正プログラムを書いておりました。
しかし根拠のない思い込みは突然正されるものです。VBAでもできるんではないか、ワークシートはリストにもってこいだしXLSファイル1個ですむ取り回しのよさ (私の周りのWindowsパソコンはすべてExcel標準装備です) も魅力だ...
ということで、まずは読み出しまで。

VBAでもClassが作れるということなので、JpegExifクラスをこしらえることにします。

JpegExif クラス
プロパティ (すべて読み取り専用)
NameStringファイル名 (拡張子含む)
PathStringフルパス (ファイル名含む)
FileSizeLongファイルサイズ (byte単位)
DateTimeLastModifiedDate最終更新日付
DateTimeOriginalDate撮影日付
MakeStringメーカー名
ModelString機種名
ExifVersionStringExifバージョン
ExposureTimeString露出時間 (秒単位)。分数形式 例) 1/30
FlashBoolean発光したか否
FNumberStringFナンバー。分数形式 例) 28/10
ImageLengthLong画像縦サイズ (ピクセル単位)
ImageWidthLong画像横サイズ (ピクセル単位)
メソッド
InitSet
ファイルフルパスを受け取り、プロパティなどの値取得を行う。
引数Stringファイルフルパス
戻り値Integer
0JpegExifファイルである
2Jpegファイルであるが、Exifではない
-1ファイルが見つからない
-2ファイルが開けない
-3Jpegファイルではない
-11格納データにエラーがあるみたい

フルパスファイル名をコンストラクタの引数にできると便利なのですが、デフォルトコンストラクタ以外不可のようです。
しょうがないので、InitSetメソッドをこしらえてファイル名を渡すことにしました。
プロパティの初期値はVBAデータ型の初期値と同じです。(Longは0、Stringは空文字列、BooleanはFalse、Dateは0・・・1900年1月0日!!)
InitSetメソッドが実行されるまでは初期値のままです。

プロパティのうち、ファイル名 から最終更新日付 まではファイルシステム(OS)から提供されるものです。
撮影日付 から下が、JPEGファイル内部に書き込まれている情報です。さらにそのうちFナンバー までがExif情報、最後の画像サイズ2つはExifではなくJPEGマーカSOF(Start Of Frame)から取得しています。
Exif情報は上に挙げた以外にもたくさんありますが、切りがないので切りをつけました。

では、JpegExifクラスはすでに作成済みということにして、このクラスを使ってみます。
手頃なところで、フォルダを指定しそのフォルダにあるJPEGファイルのリストをワークシートに書き出すというマクロを作成します。 もちろん、撮影日付や露出時間などExif情報付きです。
なお、JpegExifクラスのコードはこのページの末尾に掲載します。

Option Explicit '***************************************************************** ' 指定したフォルダにある *.JPGファイルのリストを ' Sheet1に作成する。 '***************************************************************** Public Sub JPEGファイルリスト作成() Dim tFolder As String Dim fileName As String Dim objJpeg As Object Dim tRow As Long 'フォルダを指定する '要参照設定: Microsoft Office 10.0 Object Library With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then 'キャンセルの場合はこの条件式ではじかれる tFolder = .SelectedItems(1) End If End With If Len(tFolder) = 0 Then '長さ0の場合は、キャンセルされたということ Exit Sub Else If Right(tFolder, 1) <> "\" Then tFolder = tFolder & "\" End If End If '指定フォルダのJPEGファイル(拡張子jpg)を列挙 fileName = Dir(tFolder & "*.JPG", vbNormal) If Len(fileName) > 0 Then '書き出しリストを用意する With ThisWorkbook.Worksheets("Sheet1") '+++ 1行目はフォルダ名 tRow = 1 .Cells(tRow, 1).Value = "フォルダ" .Cells(tRow, 2).Value = tFolder '+++ 2行目は見出し tRow = 2 .Cells(tRow, 1).Value = "ファイル名" .Cells(tRow, 2).Value = "ファイルサイズ(byte)" .Cells(tRow, 3).Value = "最終更新日付" .Cells(tRow, 4).Value = "撮影日付" .Cells(tRow, 5).Value = "メーカー名" .Cells(tRow, 6).Value = "機種名" .Cells(tRow, 7).Value = "Exifバージョン" .Cells(tRow, 8).Value = "露出時間(秒)" .Cells(tRow, 9).Value = "発光" .Cells(tRow, 10).Value = "Fナンバー" .Cells(tRow, 11).Value = "画像サイズ(ピクセル)" End With 'リスト作成 Do Until Len(fileName) = 0 Set objJpeg = New JpegExif If objJpeg.InitSet(fileName) >= 0 Then 'InitSetメソッドの結果が0(JpegExif) または2(JpegNotExif) の場合に 'リストアップする。 tRow = tRow + 1 With ThisWorkbook.Worksheets("Sheet1") .Cells(tRow, 1).Value = objJpeg.Name .Cells(tRow, 2).Value = objJpeg.FileSize .Cells(tRow, 3).Value = objJpeg.DateTimeLastModified .Cells(tRow, 4).Value = objJpeg.DateTimeOriginal .Cells(tRow, 5).Value = objJpeg.Make .Cells(tRow, 6).Value = objJpeg.Model .Cells(tRow, 7).Value = IIf(Len(objJpeg.ExifVersion) = 4, _ Val(objJpeg.ExifVersion) / 100, objJpeg.ExifVersion) .Cells(tRow, 8).Value = "=""" & objJpeg.ExposureTime & """" .Cells(tRow, 9).Value = IIf(objJpeg.Flash, "あり", "なし") .Cells(tRow, 10).Value = "=""" & objJpeg.FNumber & """" .Cells(tRow, 11).Value = CStr(objJpeg.ImageWidth) & "x" _ & CStr(objJpeg.ImageLength) End With End If Set objJpeg = Nothing fileName = Dir Loop End If End Sub
マクロ JPEGファイルリスト作成実行の結果
マクロ実行の結果

ワークシートに書き込む際、いくつかのプロパティは多少加工しています。
分数形式の露出時間とFナンバーはそのまま書き込むと日付扱いになる場合がありますので、先頭に数式を表すイコール記号を付け、プロパティを引用符で囲むようにしました。
発光したか否は「あり」「なし」で表示、画像サイズは横と縦のサイズをx(スモールエックス)で連結してあります。
Exifバージョンは、4バイトのASCII文字列としてJPEGファイル内に格納されています。参考にしたバージョン2.1の仕様書では「0210とする」としか書かれていません。プロパティはASCII文字列そのままですので、上2桁がメジャー下2桁がマイナーバージョンと解釈し、数値化の後100で割りました。
他のプロパティはそのまま書き込んでいます。

VBAで自作のクラスを使うのは初めてでしたが、すっきりしたコード記述ができるのにびっくりしました。 撮影日付読み出しの苦労を微塵も感じさせないところがいいですね。
インテリセンスも効きますし。 (訂正します。Dim objJpeg As Object では、インテリセンスは効きませんね。Dim objJpeg As JpegExif でないと)

最後に、少々長いですがJpegExifクラスのプログラムコードをご披露します。苦労の様が暴露されます。

'///////////////////////////////////// ' JpegExifクラス ' ver 1.00 読み出し専用 '///////////////////////////////////// Option Explicit Const TAG_DATETIMEORIGINAL = 36867 Const TAG_MAKE = 271 Const TAG_MODEL = 272 Const TAG_EXIFVERSION = 36864 Const TAG_EXPOSURETIME = 33434 Const TAG_FLASH = 37385 Const TAG_FNUMBER = 33437 Const TAG_EXIF_IFD = 34665 Private cName As String Private cPath As String 'ファイル名まで含めたフルパス Private cFileSize As Long 'byte単位 Private cDateTimeLastModified As Date Private cDateTimeOriginal As Date Private cMake As String Private cModel As String Private cExifVersion As String Private cExposureTime As String Private cFlash As Boolean Private cFNumber As String Private cImageWidth As Long Private cImageLength As Long Private cEndian As Integer 'IFDにおける整数格納形式 1:BigEndian -1:LittleEndian Private cAddrTifHead As Long 'Tifヘッドアドレス 'IFDのオフセットはすべてここを基準とする ' インスタンスが作成されるときInitializeイベントが発生する Private Sub Class_Initialize() cEndian = 1 End Sub '***** プロパティ ***** '***** ファイル名 Public Property Get Name() As String Name = cName End Property '***** フルパス Public Property Get Path() As String Path = cPath End Property '***** ファイルサイズ(byte単位) Public Property Get FileSize() As Long FileSize = cFileSize End Property '***** ファイル最終更新日付 Public Property Get DateTimeLastModified() As Date DateTimeLastModified = cDateTimeLastModified End Property '***** 撮影日付 Public Property Get DateTimeOriginal() As Date DateTimeOriginal = cDateTimeOriginal End Property '***** メーカー Public Property Get Make() As String Make = cMake End Property '***** モデル Public Property Get Model() As String Model = cModel End Property '***** Exifバージョン Public Property Get ExifVersion() As String ExifVersion = cExifVersion End Property '***** 露出時間 Public Property Get ExposureTime() As String ExposureTime = cExposureTime End Property '***** 発光 Public Property Get Flash() As Boolean Flash = cFlash End Property '***** Fナンバー Public Property Get FNumber() As String FNumber = cFNumber End Property '***** 画像サイズたて (ピクセル単位) Public Property Get ImageLength() As Long ImageLength = cImageLength End Property '***** 画像サイズよこ (ピクセル単位) Public Property Get ImageWidth() As Long ImageWidth = cImageWidth End Property '***** メソッド ***** '********************************************************************* ' ファイル名を渡しそのファイルの実在確認と情報取得を行う。 ' fullPathはコンストラクタの引数にしたいところだが、 ' 引数付きコンストラクタを作成できないのでこのメソッドを用意した。 ' ret 0: JpegExifファイルである ' 2: JpegファイルであるがExifではない (画像サイズは取得できる) ' -1: ファイルが存在しない ' -2: (存在はするが)オープンできない ' -3: Jpegファイルではない ' -11: 格納データのフォーマットにエラーがある '********************************************************************* Public Function InitSet(ByVal fullPath As String) As Integer Dim ret As Integer Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(fullPath) Then With fso.GetFile(fullPath) cName = .Name cPath = .Path 'ファイル名も含めたフルパス cDateTimeLastModified = .DateLastModified End With ret = readJPEG() Else ret = -1 End If Set fso = Nothing InitSet = ret End Function '----- プライベート関数 ----- '---------------------------------------------------- ' Jpegファイルを読む ' ret 0: JpegExifである ' 2: JpegファイルではあるがExif形式ではない ' -2: ファイルオープン失敗 ' -3: Jpegファイルではない ' -11: データエラーあり '---------------------------------------------------- Private Function readJPEG() As Integer Dim ret As Integer Dim i As Integer Dim fnum As Integer Dim b1 As Byte Dim b2(0 To 1) As Byte Dim b4(0 To 3) As Byte Dim ba() As Byte Dim fPointer As Long 'ファイル先頭を0とする Dim segSize As Long Dim segStart As Long Dim offset As Long fnum = FreeFile On Error GoTo Er_readJPEG Open cPath For Binary Access Read As #fnum On Error GoTo 0 cFileSize = LOF(fnum) '1. SOI(StartOfImage)マーカ の確認 ' ファイル先頭が ffd8 であること fPointer = Seek(fnum) - 1 'seek関数はファイル先頭を1とするので If fPointer + 2 > cFileSize Then '読み出し不可 ret = -3 Else Get #fnum, , b2 fPointer = fPointer + 2 If Not (b2(0) = &HFF And b2(1) = &HD8) Then ret = -3 End If End If If ret < 0 Then GoTo Ex_readJPEG '2. 最初の「データ部を持つJPEGマーカ」を読む ' SOIマーカの直後 ' ff MM SS SS ' MM: マーカ識別子。Exif用のAPP1マーカの場合は e1 ' SS SS: このマーカセグメントのサイズ(上位のSSを基点とする) 符合なしBigEndian If fPointer + 4 > cFileSize Then '読み出し不可 ret = -3 Else ReDim ba(0 To 3) Get #fnum, , ba fPointer = fPointer + 4 If ba(0) = &HFF Then 'JPEGマーカ segStart = fPointer - 2 segSize = CLng(ba(2)) * 256 + CLng(ba(3)) If ba(1) = &HE1 Then '3. Exif証明書の確認 'APP1マーカであるなら続く6バイトが固定 ' 45 78 69 66 00 00 ' E x i f If fPointer + 6 > cFileSize Then ret = -11 Else ReDim ba(0 To 5) Get #fnum, , ba fPointer = fPointer + 6 If Not (ba(0) = &H45 And ba(1) = &H78 And ba(2) = &H69 And ba(3) = &H66 _ And ba(4) = 0 And ba(5) = 0) Then ret = -11 End If End If Else 'JPEGではあるが、Exif情報は持っていない ret = 2 End If Else 'JPEGファイルではない ret = -3 End If End If If ret < 0 Then GoTo Ex_readJPEG If ret = 0 Then 'Exif情報の読み出し ' Exif情報はTIFFのタグ形式。Exif証明書の直後から始まる '4. Tifヘッダの読み出し ' NN NN TT TT XX XX XX XX ' NN NN : 整数格納形式 4d4d=BigEndian 4949=LittleEndian ' TT TT : TIFF番号(整数。何を意味するかは不明) 値は &h2a (42) ' XX XX XX XX : 最初のIFD(ImageFileDirectory)へのオフセット ' 通常はTifヘッダの直後だから8 If fPointer + 8 > cFileSize Then ret = -11 Else 'Endian取得 Get #fnum, , b2 If b2(0) = &H49 And b2(1) = &H49 Then cEndian = -1 '既定値は1 End If 'TIFF番号の確認 Get #fnum, , b2 If bytesUnsignedToLong(b2) <> 42 Then 'TIFFヘッダではない ret = -11 Else 'Tiffタグ認定ができたと言うことで cAddrTifHead = fPointer 'IFD0へのオフセット値取得 Get #fnum, , b4 offset = bytesUnsignedToLong(b4) If offset > 0 Then 'IFD0 処理 offset = readIFD(fnum, offset) '次のIFD1はサムネイルに関する情報なので読まない 'IFD1で連鎖終了 Else 'オフセット値がおかしい。 '負数の場合はオフセット値が扱える範囲を超えているということだが、 '取得済みのファイルサイズ(符号あり長整数)を超えるというのはおかしい。 '0の場合は全く先に進めない。 ret = -11 End If End If End If If ret < 0 Then GoTo Ex_readJPEG End If '5. 画像サイズ取得 ' JPEGマーカ(ffc0)より取得する ' APP1タグとしてImageWidth, ImageLengthは定義されているが、 ' JPEGマーカとの重複になるので記載しないことになっている。 'ffc0マーカまでマーカ連鎖をたどる 'JPEGマーカフォーマット ' ff MM SS SS ReDim ba(0 To 3) Do Until ret < 0 Or segSize = 0 fPointer = segStart + segSize If fPointer + 4 > cFileSize Then ret = -11 Else Get #fnum, fPointer + 1, ba fPointer = fPointer + 4 If ba(0) = &HFF Then If ba(1) = &HC0 Then '目的のJPEGマーカに到達 'サイズに続く部分はマーカごとに異なる。 'ffcoマーカの場合は 'PP LL LL WW WW XX XX... ' PP: サンプル精度。通常は08 ' LL LL: イメージの縦サイズ、符合なし整数、BigEndian ' WW WW: イメージの横サイズ、同上 '5バイトだけ読み出す If fPointer + 5 > cFileSize Then ret = -11 Else Get #fnum, , b1 'PP 空読み Get #fnum, , ba cImageLength = CLng(ba(0)) * 256 + CLng(ba(1)) cImageWidth = CLng(ba(2)) * 256 + CLng(ba(3)) segSize = 0 End If Else segStart = fPointer - 2 segSize = CLng(ba(2)) * 256 + CLng(ba(3)) End If Else ret = -11 End If End If Loop Ex_readJPEG: On Error Resume Next Close fnum On Error GoTo 0 readJPEG = ret Exit Function Er_readJPEG: 'ファイルオープン失敗 ret = -2 Resume Ex_readJPEG End Function '--------------------------------------------------------------------------- ' ひとつのIFDを読み出し処理する ' ret: 次のIFDへのオフセット (次がない場合は0) ' IFDのフォーマット ' PP PP [エントリ群] NN NN ' PP PP: タグ個数 ' [エントリ群]: [エントリ](12byte)×タグ個数 ' NN NN: 次のIFDのオフセット(Tifヘッダ基点) ' エントリのフォーマット ' TT TT YY YY UU UU UU UU VV VV VV VV ' TT TT: タグ(番号) ' YY YY: データタイプ ' UU UU UU UU: 値の個数 ' VV VV VV VV: 値または値へのオフセット(Tifヘッダ基点) '--------------------------------------------------------------------------- Private Function readIFD(ByVal fnum As Integer, ByVal offset As Long) As Long Dim ret As Long Dim b2(0 To 1) As Byte Dim b4(0 To 3) As Byte Dim fPointer As Long '0基点 Dim tagCount As Long Dim tagInfo_Id() As Long Dim tagInfo_ValType() As Long Dim tagInfo_ValCount() As Long Dim tagInfo_Val() As Long Dim i As Long Dim nextIFD As Long Dim tmpStr As String fPointer = cAddrTifHead + offset 'タグ数の取得 Get #fnum, fPointer + 1, b2 tagCount = bytesUnsignedToLong(b2) If tagCount > 0 Then 'タグのエントリ情報取得 ' seekポインタはエントリ情報ブロック先頭(タグ数の直後)にある ReDim tagInfo_Id(0 To tagCount - 1) ReDim tagInfo_ValType(0 To tagCount - 1) ReDim tagInfo_ValCount(0 To tagCount - 1) ReDim tagInfo_Val(0 To tagCount - 1) For i = 0 To tagCount - 1 'タグID取得 Get #fnum, , b2 tagInfo_Id(i) = bytesUnsignedToLong(b2) '値の種類 Get #fnum, , b2 tagInfo_ValType(i) = bytesUnsignedToLong(b2) '値の個数 Get #fnum, , b4 tagInfo_ValCount(i) = bytesUnsignedToLong(b4) '値または値へのオフセット Get #fnum, , b4 Select Case tagInfo_ValType(i) Case 1 '1バイト符号なし整数 tagInfo_Val(i) = CLng(b4(0)) Case 2 'ASCII文字列へのオフセット tagInfo_Val(i) = bytesUnsignedToLong(b4) Case 3 '2バイト符号なし整数 b2(0) = b4(0) b2(1) = b4(1) tagInfo_Val(i) = bytesUnsignedToLong(b2) Case 4 '4バイト符号なし整数 tagInfo_Val(i) = bytesUnsignedToLong(b4) Case 5 '4バイト符号なし整数2個。オフセット tagInfo_Val(i) = bytesUnsignedToLong(b4) Case 7 '未定義のバイト列。タグにより扱い方が異なる If tagInfo_Id(i) = TAG_EXIFVERSION Then cExifVersion = Chr(b4(0)) & Chr(b4(1)) & Chr(b4(2)) & Chr(b4(3)) End If Case 9 '4バイト符号あり整数 tagInfo_Val(i) = bytesSignedToLong(b4) Case 10 '4バイト符号あり整数2個。オフセット tagInfo_Val(i) = bytesUnsignedToLong(b4) Case Else tagInfo_Val(i) = bytesUnsignedToLong(b4) End Select Next i '次のIFDへのオフセット取得(2byte!!) Get #fnum, , b2 ret = bytesUnsignedToLong(b2) 'エントリを順次処理 For i = 0 To tagCount - 1 If tagInfo_Id(i) = TAG_EXIF_IFD Then 'Exif IFDを処理する '取得した値はIFDへのオフセット nextIFD = tagInfo_Val(i) Do While nextIFD > 0 nextIFD = readIFD(fnum, nextIFD) Loop Else '取得の必要なTagのみ処理する Select Case tagInfo_Id(i) Case TAG_DATETIMEORIGINAL '日付データの格納形式 'yyyy:mm:dd HH:MM:SS If tagInfo_ValType(i) = 2 And tagInfo_Val(i) > 0 Then tmpStr = readASCIIAt(cAddrTifHead + tagInfo_Val(i), tagInfo_ValCount(i), fnum) If Len(tmpStr) = 19 Then ' 日付の区切りをスラッシュに変更 Mid(tmpStr, 5, 1) = "/" Mid(tmpStr, 8, 1) = "/" On Error Resume Next cDateTimeOriginal = CDate(tmpStr) On Error GoTo 0 End If End If Case TAG_MAKE 'メーカー If tagInfo_ValType(i) = 2 And tagInfo_Val(i) > 0 Then cMake = readASCIIAt(cAddrTifHead + tagInfo_Val(i), tagInfo_ValCount(i), fnum) End If Case TAG_MODEL 'モデル If tagInfo_ValType(i) = 2 And tagInfo_Val(i) > 0 Then cModel = readASCIIAt(cAddrTifHead + tagInfo_Val(i), tagInfo_ValCount(i), fnum) End If Case TAG_EXIFVERSION 'Exifバージョン 'すでに処理済み Case TAG_EXPOSURETIME '露出時間 If tagInfo_ValType(i) = 5 And tagInfo_Val(i) > 0 Then cExposureTime = readRationalAt(cAddrTifHead + tagInfo_Val(i), fnum) End If Case TAG_FLASH '発光 最下位ビットのオン・オフで判断する。 If tagInfo_Val(i) Mod 2 <> 0 Then cFlash = True Case TAG_FNUMBER 'Fナンバー If tagInfo_ValType(i) = 5 And tagInfo_Val(i) > 0 Then cFNumber = readRationalAt(cAddrTifHead + tagInfo_Val(i), fnum) End If End Select End If Next i End If readIFD = ret End Function '----------------------------------------------------------------------------- ' タグValue読み出し Type: 5(Rational)対応 ' 指定位置から符合なし4バイト整数2個を読み出す。分子・分母に相当。 ' 結果は2数をそれぞれ文字列に変換し、スラッシュで連結したもの。 ' ex) 28/10 ' 分子>=0かつ分母>0 が成り立たなければ空文字列を返す ' 引数 pos: 読み出し開始位置(ファイル先頭を0とする) ' fnum: 対象ファイルのオープン番号 '----------------------------------------------------------------------------- Private Function readRationalAt(ByVal pos As Long, ByVal fnum As Integer) As String Dim ret As String Dim b4(0 To 3) As Byte Dim tmpLong As Long Dim tmpRet As String If pos + 8 <= cFileSize Then Get #fnum, pos + 1, b4 tmpLong = bytesUnsignedToLong(b4) If tmpLong >= 0 Then tmpRet = CStr(tmpLong) Get #fnum, , b4 tmpLong = bytesUnsignedToLong(b4) If tmpLong > 0 Then ret = tmpRet & "/" & CStr(tmpLong) End If End If End If readRationalAt = ret End Function '-------------------------------------------------------------- ' タグValue読み出し Type: 2(ASCII)対応 ' 指定位置からASCII文字としてlength個読み出す。 ' ただし、Nullが出現した位置で読み出しを終了し、 ' Nullの直前までを戻り値とする。 ' 引数 pos: 読み出し開始位置(ファイル先頭を0とする) ' length: 読み出しバイト数 ' fnum: 対象ファイルのオープン番号 '-------------------------------------------------------------- Private Function readASCIIAt(ByVal pos As Long, ByVal length As Long, ByVal fnum As Integer) As String Dim ret As String Dim ba() As Byte Dim i As Long If length > 0 Then If pos + length <= cFileSize Then ReDim ba(0 To length - 1) Get #fnum, pos + 1, ba For i = 0 To length - 1 If ba(i) = 0 Then Exit For ret = ret & Chr(ba(i)) Next i End If End If readASCIIAt = ret End Function '----------------------------------------------------------------------------- ' 符号なし整数とみなすバイト配列を4バイト符号あり整数に変換 ' 引数の配列は0基底とする。 ' 4次元を超える配列はインデクス0〜3までを用いる。 ' 4次元の場合、戻り値が符号あり4バイト整数なので最上位ビットがonの場合は、 ' オーバーフローになってしまう。この場合は-1 を返す。 ' すなわち、2^31以上の格納値は扱えないということ。 '----------------------------------------------------------------------------- Private Function bytesUnsignedToLong(ba() As Byte) As Long Dim ret As Long Dim i As Integer Dim iMax As Integer iMax = UBound(ba) If iMax < 1 Then Exit Function If iMax > 3 Then iMax = 3 On Error GoTo Er_bytesUnsignedToLong If cEndian = -1 Then For i = 0 To iMax ret = ret + ba(i) * (256 ^ i) Next i Else For i = 0 To iMax ret = ret + ba(i) * (256 ^ (iMax - i)) Next i End If Ex_bytesUnsignedToLong: On Error GoTo 0 bytesUnsignedToLong = ret Exit Function Er_bytesUnsignedToLong: ret = -1 Resume Ex_bytesUnsignedToLong End Function '--------------------------------------------------------------------- ' 符合あり整数とみなすバイト配列を4バイト符合あり整数に変換 ' 引数の配列は0基底とする。 ' 4次元を超える配列はインデクス0〜3までを用いる。 '--------------------------------------------------------------------- Private Function bytesSignedToLong(ba() As Byte) As Long Dim ret As Long Dim bt() As Integer Dim i As Integer Dim iMax As Integer Dim s As Long Dim carry As Integer iMax = UBound(ba) If iMax < 1 Then Exit Function If iMax > 3 Then iMax = 3 'Little Endianとして処理を行うために配列を移し替える ReDim bt(0 To iMax) If cEndian = -1 Then For i = 0 To iMax bt(i) = CInt(ba(i)) Next i Else For i = 0 To iMax bt(i) = CInt(ba(iMax - i)) Next i End If '最上位バイトの最上位ビットを調べ結果値の符号を求める If bt(iMax) < 128 Then s = 1 Else s = -1 End If '負の場合のみ符号反転処理実施 If s = -1 Then '最下位バイトから順に繰り上げを考慮しながら2の補数に変換 carry = 0 '繰り上げ For i = 0 To iMax bt(i) = bt(i) + carry 'この操作でByte型の範囲を逸脱する可能性 'があるのでInteger型に変換してある If bt(i) > 0 Then bt(i) = &H100 - bt(i) carry = 1 End If Next i End If For i = 0 To iMax ret = ret + bt(i) * (256 ^ i) Next i bytesSignedToLong = ret * s End Function
【参考サイト・文献】
JEIDA ディジタルスチルカメラ用画像ファイル フォーマット規格 (Exif) Version 2.1
【改訂履歴】
2009/10/21
2009/10/22 マクロ実行結果図挿入
2009/11/16 Dim objJpeg As Object ではインテリセンスは効かない
2009/11/24 レイアウト微修正 (スタイルシートを少しかまいました。)
2009/12/01 本文の文字を少し小さくしました。
btinc.jp ページ先頭 発表会演目一覧