ExcelVBAで挿入画像の縦横サイズをゲットしたいです

ExcelVBA(Windows)にて画像を挿入してサイズ変更をしますのに
Set P = LoadPicture(PicName)
がjpeg、gif(bmpも？)にしか対応していない関係で、pngの画像の
縦横サイズをゲットするのにこちら
https://vbabeginner.net/get-width-height-png/
を参考に書いてみました。
ここで、Windowsではjpeg、gif、pngの画像の縦横サイズをゲット
してリサイズ出来ましたけれど、MACではLoadPictureがありません
ので、上記サイトのpng画像のようにjpeg、gifもバイナリから
縦横サイズをゲットしたいと思っています。
何か参考となりますサイトがありましたら、教えて頂きたいと思います。

pos = InStrRev(PicID, ".")
ext = LCase(Mid(PicID, pos + 1))

If ext = "JPG" Or ext = "JPEG" Or ext = "GIF" Or ext = "jpg" Or ext = "jpeg" Or ext = "gif" Then

Set P = LoadPicture(PicName)
a_lWidth = P.Width
a_lHeight = P.Height

ElseIf ext = "PNG" Or ext = "png" Then

ReDim byData(23)
iFileNo = FreeFile

Open PicName For Binary As #iFileNo

Get #iFileNo, , byData

Close #iFileNo

If (byData(0) = 137) And (byData(1) = 80) And (byData(2) = 78) And (byData(3) = 71) And _
(byData(4) = 13) And (byData(5) = 10) And (byData(6) = 26) And (byData(7) = 10) And _
(byData(8) = 0) And (byData(9) = 0) And (byData(10) = 0) And (byData(11) = 13) And _
(byData(12) = 73) And (byData(13) = 72) And (byData(14) = 68) And (byData(15) = 82) Then

a_lWidth = byData(16) * 16777216 + byData(17) * 65536 + byData(18) * 256 + byData(19)
a_lHeight = byData(20) * 16777216 + byData(21) * 65536 + byData(22) * 256 + byData(23)

End If

End If

No.1 ベストアンサー 回答者： fujillin 回答日時： 2021/03/30 17:35

こんにちは

MACに関しては全くわかりませんが、Shapes.AddPictureも使えませんか？

テキストファイルで読んで解析するよりも、画像を読み込んでからサイズを取得するほうが簡単だと思うのですが。
（読み込めるかどうかが不明ですけれど…）

以下は、元の画像サイズのまま一旦読み込んで、サイズを表示する例です。
（windows10ですが、jpgでもpngでも読み込めます）

filepath = "画像のパス"

Set s = ActiveSheet.Shapes.AddPicture(filepath, 0, 1, 100, 100, -1, -1)
MsgBox "height:" & s.Height & "pt" & vbCrLf & "width:" & s.Width & "pt"

この回答へのお礼

ありがとうございます
処理がめっちゃ速くなりました
相変わらずMACでは動きませんけれど…

お礼日時：2021/03/31 10:12