• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:VBAで画像のドット位置を探す。)

VBAで画像のドット位置を探す方法

このQ&Aのポイント
  • エクセルのVBAを使用して、画像上のドット位置を解析する方法について知りたいです。具体的には、(1)画像の取り込み方法、(2)黒色ドットの定義方法、(3)ドットの位置の抽出方法について教えてください。
  • エクセルのVBAを使って画像上のドットの位置を解析する方法について教えてください。画像の取り込み方法、黒色ドットの定義方法、ドットの位置の抽出方法について知りたいです。
  • エクセルのVBAを使って画像上にあるドットの位置を解析する方法について教えてください。画像の取り込み方法、黒色ドットの定義方法、ドットの位置の抽出方法について詳しく教えてください。

質問者が選んだベストアンサー

  • ベストアンサー
  • mt2008
  • ベストアンサー率52% (885/1701)
回答No.3

> 内容に関してですが、bData(19) bData(23)は何を意味しているのでしょうか? > ヘッダーの解説には、19と23についての記載がありませんでした。 ヘッダの解説をよく見てみてください。 [18]からの4byte(18~21)が画像の幅[ピクセル] [22]からの4byte(22~25)が画像の縦[ピクセル] です。 ですから、本当は4byte分でピクセルサイズを求めるべきなのですが、私のコードは予めお断りしている通り手抜き版なので「そんなに大きな画像は読み込まないだろう」とたかをくくって2byte(18と19、22と23)だけ使ってピクセルサイズを求めています。 どの辺りが手抜きなのか説明するべきでしたね。失礼しました。 BMPは1ピクセルごとに情報が取り出せるので簡単ですが、PNGやJPEGは圧縮されているのでそう簡単にはいきません。 私なら他のアプリでBMPに変換してしまいます(^^;

unserious
質問者

お礼

本当にありがとうございます。 まさかできないだろうと思ったことでしたので、ちょっと面白そうです。 しばらく参照しながら頑張ってみます。

その他の回答 (2)

  • mt2008
  • ベストアンサー率52% (885/1701)
回答No.2

あぁ、間違えた。7行目、以下の様に直してください If sPath <> Then Exit Sub  ↓ If sPath = "" Then Exit Sub

  • mt2008
  • ベストアンサー率52% (885/1701)
回答No.1

1.ファイルを取り込むというか、BMPファイルをバイナリファイルとして読み込む事になると思います。  読み込んだバイナリを配列に取り込んでも良いですね。  Open パス名 For Binary As ファイル番号 で開きます。 2.8bit以下のBMPならカラーパレットを参照、24bit以上ならRGBが全て0の物を探すことになるかと思います。 3.通常のBMPはデータが左下から右上に向かって記録されていますので、何番目のデータかと言う情報と、ヘッダ情報の解像度と合わせれば位置がわかります。 参考になりそうなサイトのリンクを貼っておきます。 http://www.kk.iij4u.or.jp/~kondo/bmp/ http://www.umekkii.jp/data/computer/file_format/bitmap.cgi 一応、手抜きのサンプルも…。 無圧縮の24bitBMPにしか対応していません。 黒いドットを見つけるごとにA列に縦位置、B列に横位置を記入していきます。 Sub Sample()   Dim bData() As Byte   Dim nFn As Integer   Dim sPath, nW, nH, nCount, nFind, i, j   'BMPファイル選択   sPath = Application.GetOpenFilename(FileFilter:="ビットマップファイル(*.bmp),*.bmp", FilterIndex:=1, Title:="BMP選択", MultiSelect:=False)   If sPath <> "" Then Exit Sub      'BMPを配列に読み込む   nFn = FreeFile   Open sPath For Binary As #nFn     ReDim bData(LOF(nFn))     Get #nFn, , bData   Close #nFn      If bData(28) <> 24 Then     MsgBox ("24bitBMPじゃないので終了")     Exit Sub   End If   nW = bData(18) + 256 * bData(19) '横サイズ   nH = bData(22) + 256 * bData(23) '縦サイズ   nCount = CLng(bData(10)) 'データオフセット   nFind = 1   '4byte調整用   nPlus = 0   If (nW Mod 4) > 0 Then     nPlus = 4 - (nW Mod 4)   End If      For i = 1 To nH     For j = 1 To nW       nWork = CLng(bData(nCount)) + CLng(bData(nCount + 1)) + CLng(bData(nCount + 2))       nCount = nCount + 3       '黒の時の処理       If nWork = 0 Then         Range("A" & nFind) = nH - i + 1         Range("B" & nFind) = j         nFind = nFind + 1       End If       nCount = nCount + nPlus '横ラインは4の倍数byte     Next j   Next i   MsgBox ("確認終了") End Sub

unserious
質問者

補足

大変ありがとうございます。 内容を理解するのに少し時間がかかりましたが、とても具体的で助かります。 内容に関してですが、bData(19) bData(23)は何を意味しているのでしょうか? ヘッダーの解説には、19と23についての記載がありませんでした。 ご回答からは、ヘッダーのルールを抑えておけば、いけるように感じましたが、PNGファイルやJPEGも同様の考え方でいけるでしょうか?

関連するQ&A