[[20060624174313]] 『excel_vbaでスクリーン上のpixelの色を拾いたい』(夕焼) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『excel_vbaでスクリーン上のpixelの色を拾いたい』(夕焼)

 Excel_VBAを駆使して、マクロを実行して、EXCELワークシートが
表示されているScreeen画面の 希望位置(X1,Y1座標のpixel)の
色(番号)を求めたいのですが、どんなコードになるでしょうか。
  どうも、APIというものを利用すると出来る可能性があるので
しょうか。
 お願いします。

 Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long

 Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hdc As Long) As Long

 Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long

 Declare Function GetPixel Lib "gdi32.dll" _
        (ByVal hdc As Long, ByVal nXPos As Long, ByVal nYPos As Long) As Long

 Type POINTAPI
    X As Long
    Y As Long
 End Type

 Sub gjdfdr()
    Dim hdc As Long, Color As Long
    Dim pt As POINTAPI

    Call GetCursorPos(pt)
    hdc = GetDC(0)
    Color = GetPixel(hdc, pt.X, pt.Y)
    Call ReleaseDC(0, hdc)

    Dim R As Byte, G As Byte, B As Byte
    R = Color And &HFF
    G = Color \ &H100 And &HFF
    B = Color \ &H10000 And &HFF

    MsgBox R & ", " & G & ", " & B
 End Sub


 コードありがとうございました。
参考にして,ワークシート上の図形(赤色)の面積もどき
を求めるマクロをつくりました。
単に赤色の点(pixel)を数えるvbaですが
定数をかければほぼ面積に置き換わると
思います。
 ワークシート上の赤色点を集計します。
但し,pixelはX=36から1000
Y=16から500の範囲にある赤色です。

Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long

 Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hdc As Long) As Long

 Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long

 Declare Function GetPixel Lib "gdi32.dll" _
        (ByVal hdc As Long, ByVal nXPos As Long, ByVal nYPos As Long) As Long

Sub test2()

'’’ 色個数調査’’赤色図形面積調査

For Y = 165 To 500
For X = 36 To 1000
hdc = GetDC(0)

     color1 = GetPixel(hdc, X, Y)
Call ReleaseDC(0, hdc)
          If color1 = 255 Then
          count1 = count1 + 1
          ymax = Y
           If xmax < X Then
           xmax = X
              End If
     End If

    Next
    Next
    Dim R As Byte, G As Byte, B As Byte
    R = color1 And &HFF
    G = color1 \ &H100 And &HFF
    B = color1 \ &H10000 And &HFF

    'MsgBox X & ", iro=" & color1 & " ," & R & " , " & G & ", " & B & 
", n= " & count1
     MsgBox "面積(個数)=" & count1 & " , " & xmax & ", " & ymax

End Sub


 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

 Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
     (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long

 Declare Function GetClientRect Lib "user32.dll" _
    (ByVal hWnd As Long, lpRect As RECT) As Long

 Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long

 Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hdc As Long) As Long

 Declare Function GetPixel Lib "gdi32.dll" _
        (ByVal hdc As Long, ByVal nXPos As Long, ByVal nYPos As Long) As Long

 Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
 End Type

 Sub gjdfdr()
    Dim hdc As Long, hChild As Long
    Dim rc As RECT
    Dim y As Long, x As Long, Count As Long
    Dim xmax As Long, ymax As Long

    hChild = Get_WorkBook_hWnd(ActiveWorkbook.Name)
    Call GetClientRect(hChild, rc)
    hdc = GetDC(hChild)

    For y = 16 To WorksheetFunction.Min(rc.Bottom, 500)
    For x = 36 To WorksheetFunction.Min(rc.Right, 1000)
        If GetPixel(hdc, x, y) = 255 Then
            Count = Count + 1
            xmax = WorksheetFunction.Max(xmax, x)
            ymax = WorksheetFunction.Max(ymax, y)
        End If
    Next x, y

    Call ReleaseDC(hChild, hdc)

    MsgBox "個数 = " & Count & vbCrLf & _
           "xmax = " & xmax & ", ymax = " & ymax
 End Sub

 Function Get_WorkBook_hWnd(Text As String) As Long
    Dim hWnd As Long

    hWnd = FindWindow("XLMAIN", Application.Caption)
    hWnd = FindWindowEx(hWnd, 0, "XLDESK", vbNullString)
    Get_WorkBook_hWnd = FindWindowEx(hWnd, 0, "EXCEL7", Text)
 End Function

 おそらくワークシート上の赤色を数えるでしょう。


 再度 コードありがとうございました。(夕焼)
赤色個数は私の場合も同じ個数になりました。
 X,Yの右下座標値が特に,Y座標値が,私の
異なりました。この数値は参考値ですので
あまり,気にしませんが,違っているのが
気になりました。
 一つ,質問ですが,同じ赤色個数が得られますが
提示していただいたコードの特徴・差異がどんな
点でしょうか。
 よかったら,教えてください。


 > X,Yの右下座標値が特に,Y座標値が,私の
 >異なりました。この数値は参考値ですので
 >あまり,気にしませんが,違っているのが
 >気になりました。
 GetDC(0) はスクリーン全体のデバイスコンテキストハンドルを取得します。
 最初のマクロの GetPixel(hdc, x, y) はスクリーン座標での x, y の部分の色を取得しています。

 私が2回目に書いたものは、GetDC(hChild) でアクティブなブックの
 クライアント領域(ワークシートの部分)のデバイスコンテキストハンドルを取得し、
 それを元に GetPixel(hdc, x, y) しています。
 これはクライアント座標での x, y になりますね。

 つまり、xmax ymax の値の違いはクライアント座標とスクリーン座標の違いになるでしょう。

 夕焼さんのマクロだと、Excelのウインドウがどこにあるのかによって結果が変わると思います。


 やっぱり同じ人なのね。自分の書き込んだマクロの意味なんてわかってないでしょ。
 あなたのマクロは、ワークシート上の赤色の個数を数えるものではない。
http://www2.moug.net/bbs/exvba/20060626000016.htm

 以前にもこんなことやってたから、気になってたんだよね。
[[20060601144714]]『検索番号の順次繰り上げと、順次印刷のマクロ』(初老人)
http://www2.moug.net/bbs/exvba/20060603000022.htm


 (初老人)さん, 

 初老さんの感性からして,なにを言いたいのか ,だいたい想像は
付きますが,ひとこと言います。
  別の掲示板で,結構技術的な興味のある掲示(面積を求める)がありました
ので,自分でも,そのテーマに挑戦してみました。しかし,VBA的にはかなり
高度なテクニックを必要とするものです。したがって,わからない点は教えて
もらいながら,進めるしかありません。この掲示板で,GETDCを使った方法を
を教えてもらい利用したことが,初老さんには,人を非難するに格好の材料に
なったようですね。
  > マクロの意味なんてわかってないでしょ。
これも,究極の避難・中傷ですね。
 これにもひとこと
 私は,全ての知識を知っている必要もないし,
そのひとそれぞれのそれなりのほどほどの程度で十分とおもっています。
 従って,深い・裏にあるマクロの意味(GETDCなど)を十分に理解していなくても
一例の構文を雛形として活用できれば,それはそれとして,マクロを使うには
それでもいいのではないかと思っています。
  結果として,別掲示板に示したような,面積を求めるマクロ(ソフト)を作れた
ことで十分な実績なり,いい勉強と経験をすることができ,皆さん(質問者)に
も役に立てたという誇りを感じています。

 最後に,いづれにしろ,勉強・知識というものは習うか・書物を読むか・聞くか・
考えるかを通して成長していくしかないものです。
立派なことを言っています初老さんも,結局 習うか・書物を読むか・聞くか・して
育ってきたのではないでしょうか。

 補足

あなたのマクロは、ワークシート上の赤色の個数を数えるものではない。
   そうであれば,例の掲示板で,反論してください。
    上のコードを教えてくださった先生も示していますが,私は数を数えて
     いると思っていますが,間違っているなら,ここででなく,ちゃんと
    御指摘ください。
                            以上  (夕焼)


以前にもこんなことやってたから、気になってたんだよね。 [[20060601144714]]『検索番号の順次繰り上げと、順次印刷のマクロ』(初老人) http://www2.moug.net/bbs/exvba/20060603000022.htm

下記に上記の関連一文を掲載しておきます。

「 具体的には今回必要を感じた作業は,実は別掲示板で
次のような質問があったので,自分なりに考えた場合
に,簡単に実現できないかどうかと考えたためです。

「「-----」」は抜粋です。
「「印刷の手順ををマクロ化したいのです。なお欲をいえば、途中で「停止」
、「続行」、「最終検索番号の変更」などが出来るようになっていればなお良
いのですが(欲張り過ぎですか) 」」

 これは,類似のシートを数百枚印刷する作業を手作業でやって,いたことを
マクロ化して連続印刷するマクロの質問
です。途中で,停止や,続行をしたいという要求のため
停止したい場合は,何か決めたキー(たとえば,Aと決めて)
を押せば停止するように出来ればというふうに考えました。
   その掲示板の回答者達は,一回一回,止めて,中断するか
どうか,一回一回聞いてくるマクロを提示されましたが,
それでは数百回,返事しなければなりませんので,実用的で
ないと思い,連続で印刷中に,(一時)停止したい場合にのみ,Aキーを押す
マクロにできれば,使い勝手がずいぶん
向上するのではないでしょうか。
(それを有益か無益かと判断するのはそれぞれの考えが
あるでしょうが,それとは別に,簡単に出来るかどうか
を考えてみたかったということです。) 」

 上記一件についても言わせてもらいます。(吹雪=夕焼)

一つの問題についてその解決のヒントや鍵となることを
追求・調査・勉強する姿勢は,褒められても,今回,初老人さん
のような非難される理由はないのではないでしょう。

  言ってみれば,初老人さんのために,よりよい手法を影ながら
調査・追求していた人がいたということで,感謝すべきが当然で
ここでもって,このようなひとことを言われるとは正直,驚きです。
  もしかして,文面の感じからして上記の一件の初老人さんとは,
異質の「初老人さん」を騙った人物かもしれませんが。


 全体の流れを見てわかったのですが
 上の中傷・避難の掲示板発言の発言者「初老人」は実は,原文の引用文
 に書かれていた名前のようですね。 本当の「初老人」さんが上記中傷発言
をしたのではないことが明確のようです。
 本当の「初老人」さん! 誤解いたしまして,失礼しました。
  名前を記さないところはやはり,中傷文らしいですね。(夕焼)

  私はアカギです。このスレには、私とあなたしか書き込んではいませんよ。

 >そのひとそれぞれのそれなりのほどほどの程度で十分とおもっています。
 >従って,深い・裏にあるマクロの意味(GETDCなど)を十分に理解していなくても
 >一例の構文を雛形として活用できれば,それはそれとして,マクロを使うには
 >それでもいいのではないかと思っています。
 私も、自分で使うだけならそれでいいと思います。
 だからあなたの書き込んだ、勘違いしたマクロを見たときも
 「自分で使う分にはかまわないかな」としか思っていなかった。

 >別掲示板に示したような,面積を求めるマクロ(ソフト)を作れたことで
 >十分な実績なり,いい勉強と経験をすることができ
 こんなのあなたが作ったとは言わないでしょ。
 私の作ったマクロを少し変更しただけで、
 「面白そうなので作ってみました」なんて書き込まれたら気分悪いわ。
 十分な実績?意味がわからない。

 >上のコードを教えてくださった先生も示していますが,私は数を数えて
 >いると思っていますが,間違っているなら,ここででなく,ちゃんと
 >御指摘ください。
 何でここではダメなんでしょ。上で少し説明してますが、読みましたか?

 >吹雪=夕焼
 あなたほかの名前でも書き込んでない?

 あと、私は誰の名前も騙ってはいませんよ。言うまでもないことですが。 (アカギ)


 この文体、話の進め方(肝心なところ・自分が不利な話題は避ける)
 昔はああだった、こうだった....vba に関する知識の貧弱さが手にとるように分かる。
 やっぱりね..... (seiya)

(アカギ) さん

 折角,教えていただいた立派な先生と思っていた人に苦言を言うのは
残念ですが,少し書かせてもらいます。

 1)>私は誰の名前も騙ってはいませんよ。言うまでもないことですが。
          これは,上記に説明したように,(初老人) の表示があったため
       そのように,解釈されたわけですし,それが誤解であったらしいと
        既に説明しています。但し,自分の名前を入れずに,,(初老人)と
        あれば,当然,そのように解釈するのは当然ですから,(アカギ) さん
        自身にも,非はありますね。

 2) (アカギ) さん が非難中傷した理由が
        「 私の作ったマクロを少し変更しただけで、
 「面白そうなので作ってみました」なんて書き込まれたら気分悪いわ。」
    にあることは,この文面だけで十分わかりましたが,そのように非難される
    ことでしょうか。ずいぶん了見の狭い人なのですね。
      ここで使われているGETDCなどは,(アカギ) さんが作った命令(言葉が適当か
どうかは別として)でもなんでもないでしょう。皆さんが使えるように,マイクロ
ソフトが作ったものであり,だれでも使えるように準備されているものです。
 但し,その知識がないので,教えてもらったということで,別に,(アカギ) さんの
ものでもなんでもないのですよ。
  結局,ソフト(プログラム)というものは,人のお膳立てした道具(命令)を使って
 構文・ロジックを構成していくものでしかありません。 私が,その装具を知らなかっ
たので,教えてもらったでけであり,その装具を使い,面積まがいを算出出きるように
したのは,この私です。
 コメントもなくコードのみ,名前も出さずに記載して私も,正直,気持ち悪いと
感じていましたが,このようなことになるとは思ってもみませんでした。

 3)  それから,「面白そうなので」という意味は,図形の面積を色の数を数えて出そう
という発送は,興味深い,ということで何も「気持ち悪い」と感じるのはどうかと
思いますね。 教えたことが,ここで生かされていて,良かったというふうに思えない
ものでしょうか。

4)そのそも「私の作ったマクロを」といわれますが,私に言わせれば

 単に色を拾うという命令は最も基本であり,そのようなコードは誰が作った
とか,私のコードとは言うものではないでしょう。
 もともと,そのように命令が用意されてあるのですから。
 しかし,私が薄学のため,それを知っていないだけであったので,教えてと
いうことで教えてもらったということで,皆さんのコードでしょう。
  (ああ。こんなことを言いたくないけど)

  プログラムとは,そのような要素要素の機能を組立てて,一つの目的
(ここでは面積)を達成した時にいえることではないでしょうか。

 (seiya)さん

 あなたも,人の中傷・非難を得意とするところは,先生方に共通ですね。
 あまりいい趣味ではありませんね。(夕焼)


 一度だけコメントさせてください。 
 
 >あなたも,人の中傷・非難を得意とするところは,先生方に共通ですね。
先生方とは?
誰か先生と名乗りましたでしょうか?
それが、なおさんの思っている「先生」だとしたら、
それこそ、誤解を招きませんか?
 
 >あまりいい趣味ではありませんね。
こちらのコメントは、人の中傷・非難となりませんでしょうか?
心配です。。。
 
 以前にも書きましたが、
ここは、学校ですので、勉強をする場です。
ここで、話しを出しておいて都合がいいかもしれませんが、、、
もうやめにしましょう?
 
 HNも出来れば統一されたものをきちんと書き、
自身のスレに責任を持ち、自分の持っている概念や信念だけを押し付けるのではなく
一緒に勉強していきましょうよ〜♪
 
 独り言:(はぁ〜 また首突っ込んじゃった・・・
       ししょ〜に、怒られなければいいけど。。。)
 (キリキ)(〃⌒o⌒)b


 >ししょ〜に、怒られなければいいけど。。。)

キリキ)(〃⌒o⌒)bさん の ししょ〜 はどなたでしょうか。

 それからもうひとこと

 私は,このエクセルの学校掲示板で自分から最初に,他人を中傷・誹謗した
ことは一度もありません。
  言われる筋合いのない一方的な,中傷・非難をされれば
泣き寝入りもできませんよね。

   これまでの流れを良く読んでみてください。
           (夕焼)


 あなたがレスをつけているスレッドでは荒れているものが多いです。
 それをどう受け止めるかはあなた次第です。

 > 別の掲示板で,結構技術的な興味のある掲示(面積を求める)がありました
 > ので,自分でも,そのテーマに挑戦してみました。しかし,VBA的にはかなり
 > 高度なテクニックを必要とするものです。したがって,わからない点は教えて
 > もらいながら,進めるしかありません。この掲示板で,・・・(略)
 これは他の方に成り代わったマルチポスト行為だと思いませんか?
 この掲示板では禁止されていませんが、向こうでは禁止されているでしょう?
 エチケット、マナーなど、考えるところはあるはずです。
 これまでの流れを良く読むのはあなたではありませんか?
 (ROUGE)

 あまり言いたくはないのですが

 上にもありますように
「ここは、学校ですので、勉強をする場です。」
 他の掲示板であろうと,どこでであろうと出て来た疑問点・わから
ない点を,勉強したい,知りたい,聞きたい,教えてもらいたい
 ということで,ここで勉強し,それを活用することがエチケット、マナー
に反するでしょうか。上で十分すぎるほど書きましたがまだわかってない
ようですが,ベース・基本を活用して発展的ソフトに活用することが
おもしろくないというのは,いかがなものでしょうか。
                                (夕焼)

 ほう、又やっとりまんな。
 で、なんでっか、なおさん=夕焼け=吹雪
 ってでっか?うそでっしゃろ?
 一時の行き違いはあってもわたしゃ、なおさんをそんな目ぇで見とりまへんでぇ。

 過去の例からすればこの学校に随分貢献なさっとりますし、kazuさんからの人望も
 厚かった筈。そしてその信念は今も変わってないと思いまっせぇ。
 まさかそのkazuさんの顔に泥を塗るような真似は人間としてでける訳おまへんやろう。
 第一ここの掲示板にアラシが登場するとの噂が立ったら、レス付ける御方が疑心に満ち
 た気持ちになって、まっとうな回答を付けんようになりまっせ。

 これはなおさんの本意やありますまいに・・・。
 まだ挽回でけるチャンスはありまっせ。も一回原点に戻って「なお」を正々堂々と名乗
 りなはれ。もひとつ、自分を自分以上に見せようと背伸びしなはんな。
 此処でレスを付けとる御方は疑問点があれば堂々と自分のHNでスレを立てとりますワ。
 嬉しい事に周りの連中はその疑問にこぞって回答を寄せとります。
 これぞ我が「エクセルの学校」の真骨頂というもんですワ。
 なんとなくトラブルメーカーNO1の座ぁを追われそう(笑
       (弥太郎) 


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.