ExcelマクロVBA技術解説 | 画像サイズ(横x縦)の取得について | Excelマクロの問題点と解決策、エクセルVBAの技術的解説



最終更新日:2016-03-19

画像サイズ(横x縦)の取得について

マクロVBAで、画像サイズ(横x縦)ピクセル数を取得する方法についての解説です、

画像は種類が多いので、全ての画像に対応しようとすると、かなり面倒になります。

このような処理は、私もたびたび使いますので、自身の覚書としての意味もあり掲載します。


まず、VBAには、LoadPictur 関数があります。

これを使ってコードを書いてみると

LoadPictur 関数
Sub sample1()
  Dim pic As Object
  Dim pWidth As Long
  Dim pheight As Long
  Dim strFile As String
  strFile = Application.GetOpenFilename(FileFilter:="全てのファイル,*.*", Title:="画像ファイルを選択")
  If strFile = "False" Then
    Exit Sub
  End If
  Set pic = LoadPicture(strFile)
  pWidth = CLng(CDbl(pic.Width) * 24 / 635)
  pheight = CLng(CDbl(pic.Height) * 24 / 635)
  MsgBox "横:" & pWidth & vbLf & "縦:" & pheight
End Sub

細部は工夫してもらうとして、概ねこのような感じになります。
これで、ほとんど問題が無さそうなのですが・・・

問題があります。
それは、
対応している画像フォーマットが、

bmp
ico
rle
wmf
emf
gif
jpg


以上に限られていることです。
これだけ対応していれば問題なさそうなのですが、
良く見て下さい・・・
png
tif

良く使われる、この二つが見当たりません。
さすがに、これでは困る場合も出てきます。


では、
png
tif

これらのサイズ取得はどうするかですが、
少し発想を変えてみましょう。
シートに画像を挿入して、そのサイズを取得すればどうでしょう。
サイズは取得できるのですが、単位が違ってしまいます。
GDIに依存するはずですが、通常の状態なら、
以下で変換できます。

AddPictureしてから取得

Sub sample2()
  Dim sp As Shape
  Dim pWidth As Long
  Dim pheight As Long
  Dim strFile As String
  strFile = Application.GetOpenFilename(FileFilter:="全てのファイル,*.*", Title:="画像ファイルを選択してください")
  If strFile = "False" Then
    Exit Sub
  End If
  Set sp = ActiveSheet.Shapes.AddPicture( _
        Filename:=strFile, _
        LinkToFile:=False, _
        SaveWithDocument:=True, _
        Left:=0, _
        Top:=0, _
        Width:=0, _
        Height:=0 _
        )
  With sp
    .LockAspectRatio = msoTrue
    .ScaleHeight 1, msoTrue
    .ScaleWidth 1, msoTrue
    pWidth = CLng(.Width * 4 / 3)
    pheight = CLng(.Height * 4 / 3)
    .Delete
  End With
  MsgBox "横:" & pWidth & vbLf & "縦:" & pheight
End Sub

ほとんどの場合、これで問題ないはずです。

一応、
LoadPicture関数との合わせ技という事で、以下にコードを掲載します。

Sub sample3()
  Dim pic As Object
  Dim sp As Shape
  Dim pWidth As Long
  Dim pheight As Long
  Dim strFile As String
  strFile = Application.GetOpenFilename(FileFilter:="全てのファイル,*.*", Title:="画像ファイルを選択してください")
  If strFile = "False" Then
    Exit Sub
  End If
  Select Case Mid(strFile, InStrRev(strFile, "."))
    Case ".bmp", ".ico", ".rle", ".wmf", ".emf", ".gif", ".jpg"
      Set pic = LoadPicture(strFile)
      pWidth = CLng(CDbl(pic.Width) * 24 / 635)
      pheight = CLng(CDbl(pic.Height) * 24 / 635)
    Case Else
      Set sp = ActiveSheet.Shapes.AddPicture( _
            Filename:=strFile, _
            LinkToFile:=False, _
            SaveWithDocument:=True, _
            Left:=0, _
            Top:=0, _
            Width:=0, _
            Height:=0 _
            )
      With sp
        .LockAspectRatio = msoTrue
        .ScaleHeight 1, msoTrue
        .ScaleWidth 1, msoTrue
        pWidth = CLng(.Width * 4 / 3)
        pheight = CLng(.Height * 4 / 3)
        .Delete
      End With
  End Select
  MsgBox "横:" & pWidth & vbLf & "縦:" & pheight
End Sub


ネット検索で、画像サイズ取得でヒットするのは、
APIを使った方法が良く紹介されています。

APIを使用

Private Declare Function GdiplusStartup Lib "gdiplus" ( _
                    ByRef token As Long, _
                    ByRef inputBuf As GdiplusStartupInput, _
                    ByVal outputBuf As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" ( _
                    ByVal token As Long)
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" ( _
                    ByVal FileName As Long, _
                    ByRef image As Long) As Long
Private Declare Function GdipGetImageDimension Lib "gdiplus" ( _
                    ByVal image As Long, _
                    ByRef Width As Single, _
                    ByRef Height As Single) As Long
Private Type GdiplusStartupInput
  GdiplusVersion As Long
  DebugEventCallback As Long
  SuppressBackgroundThread As Long
  SuppressExternalCodecs As Long
End Type

Function サイズ取得関数(ByVal sImageFilePath As String, _
                  ByRef x As Single, _
                  ByRef y As Single) As Boolean
  Dim uGdiStartupInput As GdiplusStartupInput
  Dim nGdiToken As Long
  Dim nStatus As Long
  Dim hImage As Long
  sample4 = False
  x = 0: y = 0
  uGdiStartupInput.GdiplusVersion = 1
  nStatus = GdiplusStartup(nGdiToken, uGdiStartupInput, 0&)
  If nStatus = 0 Then
    nStatus = GdipLoadImageFromFile(ByVal StrPtr(sImageFilePath), hImage)
    If nStatus = 0 Then
      nStatus = GdipGetImageDimension(hImage, x, y)
      If nStatus = 0 Then
        sample4 = True
      End If
    End If
    Call GdiplusShutdown(nGdiToken)
  End If
End Function

このようなものです。
このコードは、ネットで公開されているものを、掲載しやすいように少し改造したもので、私のオリジナルではありません。
出所としては、あちこちに同様のコードが見受けられましたし、
そもそも、特段のオリジナリティも見受けられないので、ほぼそのまま掲載しています。


しかし、画像サイズの取得に、APIまで持ち出す必要があるのでしょうか。
先の、sample3までで、ほとんどの場合は問題ありません。
APIを使うと、64bitのExcelでは、PtrSafeの指定が必要になり、
PtrSafeを指定すると、Excel2007で動かないという問題が出てきます。

問題解決に当たっては、
まずは、より簡単な方法を選択してみて下さい




同じテーマ「ExcelマクロVBA技術解説」の記事

文字種(ひらがな、全半角カタカナ、半角英大文字等々)の判定
よくあるVBA実行時エラーの解説と対応
ローカルウィンドウの使い方
オブジェクトの探索方法
変数とプロシージャーの命名について
マクロとは、VBAとは
コーディングとデバッグ

新着記事 ・・・新着記事一覧を見る

Excelファイルを開かずにシート名をチェック|ExcelマクロVBAサンプル集(3月23日)
数式の参照しているセルを取得する|ExcelマクロVBAサンプル集(3月18日)
CSVの読み込み方法(改の改)|ExcelマクロVBAサンプル集(3月17日)
変数とプロシージャーの命名について|ExcelマクロVBA技術解説(2月12日)
ファイルの一覧取得・削除(File)|Google Apps Script入門(1月24日)
フォルダの一覧取得・作成・削除(Folder)|Google Apps Script入門(1月24日)
フォルダとファイルを扱う(DriveApp)|Google Apps Script入門(1月24日)
スプレッドシートが非常に遅い、高速化するには|Google Apps Script入門(1月17日)
画像のトリミング(PictureFormat,Crop)|ExcelマクロVBAサンプル集(12月27日)
シート保護|Google Apps Script入門(12月24日)

アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|ExcelマクロVBA入門
2.RangeとCellsの使い方|ExcelマクロVBA入門
3.徹底解説(VLOOKUP,MATCH,INDEX,OFFSET)|エクセル関数超技
4.Range以外の指定方法(Cells,Rows,Columns)|ExcelマクロVBA入門
5.セルの参照範囲を可変にする(OFFSET,COUNTA,MATCH)|エクセル関数超技
6.セルのコピー&値の貼り付け(PasteSpecial)|ExcelマクロVBA入門
7.変数とデータ型(Dim)|ExcelマクロVBA入門
8.ひらがな⇔カタカナの変換|エクセル基本操作
9.CSVの読み込み方法|ExcelマクロVBAサンプル集
10.VBAのFindメソッドの使い方には注意が必要です|ExcelマクロVBA技術解説



  • >
  • >
  • >
  • 画像サイズ(横x縦)の取得について

  • このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


    記述には細心の注意をしたつもりですが、
    間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
    なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。

    ↑ PAGE TOP