| |
こんにちは。かみちゃん です。
>>もしかして、画像を表示せずに、縦横のサイズを取得したいということですか？
>そうなのです。しかも、単位をピクセルでサイズ取得したいのです。
Keinさんが紹介されたページを見ながら、書き換えてみました。
ただし、ピクセルではなくドット単位に取得しています。
Sub Macro1()
Dim strFileName As Variant
Dim strFolderName As Variant
Dim i As Integer, i_Byte As Integer
Dim b As Byte
Dim FileSize As Long, x As Long, y As Long '4バイトずつ読み込むので必ずLong型
Range("A1").Select
strFileName = Application.GetOpenFilename _
("画像ファイル,*.bmp", 1, "画像ファイルを指定して下さい")
If strFileName = False Then
Exit Sub
End If
i = 2
strFolderName = Left(strFileName, InStrRev(strFileName, "\")) & "*.bmp"
strFileName = Dir(strFolderName)
Do Until strFileName = ""
Cells(i, 1).Value = strFileName
'----------------------------------------
'ＢＭＰファイル解析
'----------------------------------------
'ファイルを内部で開く
Open strFileName For Binary As #1
'1バイトから2バイト読み捨て
For i_Byte = 1 To 2
Get #1, , b
Next
'ファイルサイズを取得 3バイト目から4バイト（Long型変数で取得）
Get #1, , FileSize
'7バイトから12バイト読み捨て
For i_Byte = 7 To 18
Get #1, , b
Next
'イメージの幅（つまり横のドット数）を取得 19バイト目から4バイト（Long型変数で取得）
Get #1, , x
'イメージの高さ（つまり縦のドット数）を取得 23バイト目から4バイト（Long型変数で取得）
Get #1, , y
Close #1
'ＢＭＰファイル解析 終了
MsgBox "画像ファイル名 " & strFileName & vbCrLf & _
"ファイルサイズ " & FileSize & vbCrLf & _
"縦 " & y & vbCrLf & _
"横 " & x
strFileName = Dir
i = i + 1
Loop
Range("A1").Select
End Sub
>そして、メッセージボックスではなく、セルに結果（ファイル名・幅・高さ）を表示したいのです。
Msgbox "aaa"
は
Cells(1,1)="aaa"
のよう感じで書けますので、ご自分で書き直してみてください。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
