Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Re: 図形をクリックした時にイベントを発生させたい

3,062 views
Skip to first unread message

y sakuda

unread,
Nov 14, 2006, 8:11:27 AM11/14/06
to
"Sato" <sa...@discussions.microsoft.com> wrote in message
news:99C18739-DE7C-43D9...@microsoft.com...
> 挿入→図→ファイルから→任意のJpeg等のファイルを挿入。
>
> 上記の手順で、Sheet上に挿入したオブジェクトをクリックした時の座標を取得したいのですが、Classモジュール等を使えばできそうな気がするのですが、いまひとつうまくできません。
> 何かいい方法はないでしょうか?

標準モジュールに↓のコードを入れ、図を右クリック⇒マクロの登録 で登録してください
Sub test()
Dim wShape As Shape
With ActiveSheet
Set wShape = .Shapes(Application.Caller)
MsgBox wShape.Name & wShape.Left & "#" & wShape.Top
End With
End Sub
こうしておいて図をクリックすると、図の名前と座標が表示されます。

--
ニュースグループの購読にはOutlook Express などのニュースリーダーを
使用してください。

下記のサイトをご覧下さい
http://www.microsoft.com/japan/support/newsgroup/faq/q3.asp
http://www.microsoft.com/japan/support/newsgroup/grouplist.asp

y sakuda Microsoft MVP for Office - Excel (Jan 2006 - Dec 2006)
sakudaya...@hotmail.com

VBA,VBSによるツールなどがあります
http://www16.plala.or.jp/ysakuda/ystop.htm
9月9日 VBAのページに、"アイコンギャラリー" を追加しました

y sakuda

unread,
Nov 15, 2006, 7:04:52 AM11/15/06
to
"Sato" <sa...@discussions.microsoft.com> wrote in message
news:24A4CEC5-E7E7-4EBE...@microsoft.com...

> 取得したい座標値は、オブジェクトをクリックした時のマウスカーソルの位置をオブジェクトの左上を原点としたときの相対座標です。
> 例えば全ての列幅が1.63(18ピクセル)で全ての行高が13.50(18ピクセル)だったときに、セルB2の左上からセルZ10の右下までの範囲に任意の図形を挿入してあったとして、セルF5の左上付近をクリックしたときに(Moveupのイベントのように)、「X:72、Y:54」というような結果を取得したいと考えています。
> コントロールツールボックスのイメージを挿入して、イメージのPictureプロパティに任意のJpeg等のファイルを指定してあれば、イメージのMoveupイベントで上記の座標を取得することは可能だったのですが、同じことを挿入したオブジェクトで実現したいのですが、なにかいい方法をご教示いただければ幸甚です。

Shape にはそのようなイベントはありませんし、APIを使用しないとカーソルの座標を取得することは
できません。
ですから、やるとするとかなり無理やりとなります。
昨日のフォローで、図の座標を取得する方法を示しましたので、カーソルの座標を取得するコードのみ
提示します。
あとは組み合わせて工夫してみてください

標準モジュールに↓を丸ごと貼り付けて、Testを図にマクロ登録してみてください。

Public Type lpPoint
lpX As Long
lpY As Long
End Type
Public Declare Function GetCursorPos Lib "user32" (pPoint As lpPoint) As
Boolean

Sub test()
Dim wPoint As lpPoint
If Not GetCursorPos(wPoint) Then
MsgBox wPoint.lpX & "#" & wPoint.lpY
End If
End Sub

kounoike

unread,
Nov 16, 2006, 5:23:51 AM11/16/06
to
"Sato" <sa...@discussions.microsoft.com> wrote in message
news:24A4CEC5-E7E7-4EBE...@microsoft.com...

> コントロールツールボックスのイメージを挿入して、イメージのPictureプロパティに任意のJpeg等のファイルを指定してあれば、イメージのMoveupイベントで上記の座標を取得することは可能だったのですが、同じことを挿入したオブジェクトで実現したいのですが、なにかいい方法をご教示いただければ幸甚です。

イメージのコントロールは今まで使用したことはないので、何とも言えないのですが。ちょっと、上の記事を読んでて不思議に思ったのは、「イメージのMoveupイベントで上記の座標を取得することは可能だった」と書かれているのに、どうしてその方法ではまずいんだろうということです。Jpegのサイズとイメージのコントロールのサイズを同じにすれば、イメージコントロールのイベントで簡単に座標は取得できるのではないでしょうか。

Miyahn

unread,
Nov 20, 2006, 4:19:45 PM11/20/06
to
# 投稿前にニュースグループのルールとマナーを確認しましょう。
# 投稿/閲覧には Web ベースでないニュースリーダの利用を推奨します。
# 適宜改行を入れましょう。

"Sato" さんは、2006年11月14日 18:31 の
「図形をクリックした時にイベントを発生させたい」 で、こう書かれました。


> 挿入→図→ファイルから→任意のJpeg等のファイルを挿入。
>
> 上記の手順で、Sheet上に挿入したオブジェクトをクリックした時の座標を
> 取得したいのですが、Classモジュール等を使えばできそうな気がするの
> ですが、いまひとつうまくできません。

Excel アプリケーション自体には、クリックイベントがありませんから、
(右クリックやダブルクリックは別として) WithEvents キーワードを付けた
変数宣言を含むクラスを作成しても無理でしょう。
ActiveWindow をサブクラス化して、ウィンドウメッセージをフックする
のは、クラッシュの危険がありますし。

y sakuda さんの提示した、オブジェクトに登録したマクロによる方法なら、
GetCursolPos API と ActiveWindow の PointsToScreenPixelsX(Y) メソッドを
組み合わせればなんとかできるはずですが、以前利用しようとして挫折したこと
がありましたので今回改めて挑戦してみました。

ヘルプやサポート技術情報には記述がない、画面解像度と画面のズーム倍率を
考慮した補正値を組み込まないといけないようです。

標準モジュールに下記コードをコピー&ペーストし、y sakuda さんの記事に
あるように、オブジェクトのマクロとして Check_MousePosition を登録
して下さい。

Option Explicit

Private Type POINTAPI: X As Long: Y As Long: End Type
Private Declare Function GetCursorPos Lib "user32" ( _
lpPoint As POINTAPI) As Long
Const DPIKey = _
"HKCU\Control Panel\Desktop\WindowMetrics\AppliedDPI"
'
Sub Check_MousePosition()
Dim MousePos As POINTAPI, Origin As POINTAPI
Dim aCell As Range, DispDPI As Long, Factor As Double
Dim X As Double, Y As Double
With CreateObject("WScript.Shell")
DispDPI = .RegRead(DPIKey)
End With
Factor = DispDPI / 72 * ActiveWindow.Zoom / 100
With ActiveWindow
Set aCell = .VisibleRange.Cells(1)
Origin.X = .PointsToScreenPixelsX(aCell.Left * Factor)
Origin.Y = .PointsToScreenPixelsY(aCell.Top * Factor)
End With
GetCursorPos MousePos
X = (MousePos.X - Origin.X) / Factor + aCell.Left
Y = (MousePos.Y - Origin.Y) / Factor + aCell.Top
With ActiveWindow.RangeFromPoint(MousePos.X, MousePos.Y)
MsgBox "X= " & Int(X - .Left) & " Y= " & Int(Y - .Top)
End With
Set aCell = Nothing
End Sub

# 左(上)端をクリックすると、マイナスの数値が表示されることがあります。

--
Miyahn
Microsoft MVP for Microsoft Office - Excel(Jan 2006 - Dec 2006)
Miyahn's Archive: http://homepage2.nifty.com/miyahn/

0 new messages