ビットマップ画像の色の取得2012.09.27 [更新日]2024.12.04
Win32APIを用い、ビットマップ画像の色を取得するサンプルコードとメモです。
ポイント
・画像の高さ・幅の取得
・Application.PathSeparatorプロパティ
・WinAPI
Excelマクロ管理ツール
サンプルコード
BMP画像の色を取得し、セル背景色にそれらを設定していくサンプルコード(Excel2010以降用)。
(セル背景色に設定する色が多すぎる場合 エラーになることがあります)
※ 事前に高さ・幅とも 300 ピクセル以内のBMP画像を準備しておく
※ 関連ソフト:「画像とセル背景色の相互変換」アドイン
' ***(宣言セクションに記述)*** '------------------------------- ' Win32API '------------------------------- '《指定したデバイスと互換性のあるメモリ デバイス コンテキストを作成》 ' https://learn.microsoft.com/ja-jp/windows/win32/api/wingdi/nf-wingdi-createcompatibledc Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" ( _ ByVal hDC As LongPtr) As LongPtr '《指定したデバイス コンテキストを削除》 ' https://learn.microsoft.com/ja-jp/windows/win32/api/wingdi/nf-wingdi-deletedc Declare PtrSafe Function DeleteDC Lib "gdi32" ( _ ByVal hDC As LongPtr) As Long '《指定したオブジェクトを削除》 ' https://learn.microsoft.com/ja-jp/windows/win32/api/wingdi/nf-wingdi-deleteobject Declare PtrSafe Function DeleteObject Lib "gdi32" ( _ ByVal hObject As LongPtr) As Long '《指定したデバイス コンテキストにオブジェクトを選択》 ' https://learn.microsoft.com/ja-jp/windows/win32/api/wingdi/nf-wingdi-selectobject Declare PtrSafe Function SelectObject Lib "gdi32" ( _ ByVal hDC As LongPtr, _ ByVal hObject As LongPtr) As LongPtr '《指定した座標にあるピクセルのRGBの色値を取得》 ' https://learn.microsoft.com/ja-jp/windows/win32/api/wingdi/nf-wingdi-getpixel Declare PtrSafe Function GetPixel Lib "gdi32" ( _ ByVal hDC As LongPtr, _ ByVal x As Long, _ ByVal y As Long) As Long '《アイコン、カーソル、アニメーションカーソル、またはビットマップを読み込む》 ' https://learn.microsoft.com/ja-jp/windows/win32/api/winuser/nf-winuser-loadimagea Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" ( _ ByVal hinst As LongPtr, _ ByVal lpszName As String, _ ByVal uType As Long, _ ByVal cxDesired As Long, _ ByVal cyDesired As Long, _ ByVal fuLoad As Long) As LongPtr '------------------------------- ' 定数 '------------------------------- ' LoadImageA関数のパラメーター ' 名前で指定されたファイルからスタンドアロン イメージを読み込む Const LR_LOADFROMFILE = &H10 ' ***(ここまで)***
'----------------------------------------------------------------- ' BMPファイルの色を取得しシートの背景色に設定 '----------------------------------------------------------------- '[作成日]2012.09.27 [更新日]2024.12.04 ' https://excel.syogyoumujou.com/memorandum/get_bmp.html '----------------------------------------------------------------- Sub BMPファイルの色を取得しシートの背景色に設定する() On Error GoTo LBL_ERROR '--------------------------------------- ' ファイルを選択 '--------------------------------------- Dim varFilePath As Variant Dim strFilePath As String '《ファイル選択ダイアログボックス》 ' ・ 引数1:ファイルフィルター ' ・ 引数2:ファイルインデックス(既定で表示するフィルター文字列の指定) ' ・ 引数3:ダイアログボックスタイトル ' ・ 引数4:ボタンテキスト(Macintosh用) ' ・ 引数5:複数選択の設定(True:複数選択可 False:複数選択不可) varFilePath = Application.GetOpenFilename("ビットマップ,*.bmp", _ 1, _ "BMPファイルを選択してください ※ファイルの幅・高さ共に300ピクセル以内", _ , _ False) '[キャンセル]ボタンをクリックした場合は抜ける If VarType(varFilePath) = vbBoolean Then Exit Sub ' ファイルパスを文字列型変数に代入 If IsArray(varFilePath) Then strFilePath = varFilePath(LBound(varFilePath)) Else strFilePath = varFilePath End If '--------------------------------------- ' 画像の色取得 '--------------------------------------- Dim varArray2dColor As Variant '《画像の各ピクセルの色を取得し2次元配列に設定》 ' ・ 引数1:画像のファイルパス varArray2dColor = getArray2dPixcelColor(strFilePath) If Not IsArray(varArray2dColor) Then MsgBox "画像の幅・高さが処理対応上限を超えています" & vbLf & _ "最大処理対応ピクセル:300×300", vbExclamation Exit Sub End If '--------------------------------------- ' シートに色を設定 '--------------------------------------- Application.ScreenUpdating = False ' 新規ブックを追加しシートをセット Dim shtNew As Worksheet Set shtNew = Workbooks.Add.Worksheets(1) ' シートの列幅・行高さ調整 shtNew.Cells.ColumnWidth = 0.23 shtNew.Cells.RowHeight = 2.25 Dim i As Long Dim j As Long For i = 1 To UBound(varArray2dColor, 1) For j = 1 To UBound(varArray2dColor, 2) shtNew.Cells(i, j).Interior.Color = varArray2dColor(i, j) Next Next Application.ScreenUpdating = True On Error GoTo 0 Exit Sub '--------------------------------------- ' エラー処理 '--------------------------------------- LBL_ERROR: MsgBox "エラー番号:" & Err.Number & vbLf & _ "エラー説明:" & Err.Description, vbExclamation End Sub
'----------------------------------------------------------------- ' 画像の各ピクセルの色を取得し2次元配列に設定 '----------------------------------------------------------------- '[引数] ' FilePath:画像のファイルパス '[戻り値] ' 成功:各ピクセルの色値が設定された2次元配列 ' 失敗:Empty '[作成日]2012.09.27 [更新日]2024.12.04 ' https://excel.syogyoumujou.com/memorandum/get_bmp.html '----------------------------------------------------------------- Function getArray2dPixcelColor(ByVal FilePath As String) As Variant '--------------------------------------- ' 画像の幅と高さを取得 '--------------------------------------- Dim objImage As Object Dim lngWidth As Long Dim lngHeight As Long '《イメージ読込》 ' 引数1:画像のファイルパス Set objImage = LoadPicture(FilePath) lngWidth = CLng(objImage.Width * 0.0378) lngHeight = CLng(objImage.Height * 0.0378) Set objImage = Nothing ' 想定範囲を超える画像の場合は処理を抜ける If 300 < lngHeight Or 300 < lngWidth Then Exit Function '--------------------------------------- ' 2次元配列生成 '--------------------------------------- Dim varArray2d() As Variant ReDim varArray2d(1 To lngHeight, 1 To lngWidth) '--------------------------------------- ' 画像の色取得 '--------------------------------------- Dim i As Long Dim j As Long Dim hdlDC As LongPtr Dim hdlbmp As LongPtr Dim hdlOldBmp As LongPtr '《メモリデバイスコンテキスト作成》 ' ・ 引数1:既存の DC へのハンドル ' ※ 0 の場合は現在の画面と互換性のあるメモリ DC を作成する hdlDC = CreateCompatibleDC(0) '《ビットマップ読込》 ' ・ 引数1:読み込まれるイメージを含む DLL 等へのハンドル ' ・ 引数2:ファイルフルパス ※ 第6引数が LR_LOADFROMFILE の場合 ' ・ 引数3:読み込むイメージの種類 ' ・ 引数4:アイコンまたはカーソルの幅 ' ・ 引数5:アイコンまたはカーソルの高さ ' ・ 引数6:パラメーター hdlbmp = LoadImage(0, FilePath, 0, 0, 0, LR_LOADFROMFILE) '《オブジェクト選択》 ' ・ 引数1:対象 DC へのハンドル ' ・ 引数2:選択するオブジェクトへのハンドル ' ※ 戻り値は置き換えられるオブジェクトへのハンドル hdlOldBmp = SelectObject(hdlDC, hdlbmp) ' 各ピクセルの色を取得 For i = 1 To lngHeight For j = 1 To lngWidth '《指定座標ピクセルの色値取得》 ' ・ 引数1:デバイスコンテキストへのハンドル ' ・ 引数2:ピクセルの x 座標 ' ・ 引数3:ピクセルの y 座標 varArray2d(i, j) = GetPixel(hdlDC, j - 1, i - 1) Next Next '《オブジェクト選択》 ' 選択オブジェクトを戻す hdlbmp = SelectObject(hdlDC, hdlOldBmp) '《デバイス コンテキスト削除》 ' 引数1:デバイスコンテキストへのハンドル Call DeleteDC(hdlDC) '《オブジェクト削除》 ' 引数1:デバイスコンテキストへのハンドル Call DeleteObject(hdlbmp) '--------------------------------------- ' 戻り値設定 '--------------------------------------- getArray2dPixcelColor = varArray2d End Function
VBAコードをカラーで印刷・Web掲載するためのツールはこちら
メモ
画像の大きさ(高さと幅)の取得】
LoadPicture関数を用い、Object変数に画像を読み込み、その高さと幅を取得。
LoadPicture関数は、Picture型のオブジェクトを返す。
PictureオブジェクトのWidth、Heightプロパティから、画像の高さと幅を求めるが、それらの単位はピクセルではない。
単位をピクセルに変換するため、0.0378を掛け、さらにCLng関数で丸める。
LoadPicture関数
フォームやイメージコントロール等のPictureプロパティや、Iconプロパティに画像を表示する。
構文:LoadPicture([picturefilename])
[picturefilename]
画像のパス・ファイル名を指定。引数を省略、又は「""」空の文字列にすると、既に設定されている画像が消去される。
Application.PathSeparatorプロパティ
[ 参照 ]
CreateCompatibleDC / DeleteDC関数 (Win32API)
[参考]Microsoft Learn Challenge CreateCompatibleDC 関数
Microsoft Learn Challenge DeleteDC 関数
LoadImage / SelectObject / DeleteObject関数 (Win32API)
[参考]Microsoft Learn Challenge LoadImageA 関数
Microsoft Learn Challenge SelectObject 関数
Microsoft Learn Challenge DeleteObject 関数