VBA 画像ファイル ダブルクリック

質問

エクセルVBAで以下のことがしたいです。
シート内にある画像ファイル上でダブルクリックをすると
その部分にオートシェイプの丸が表示される。

セルをダブルクリックを見かけましたが
画像をダブルクリックでということは可能でしょうか？

またこれは可能であればですが
上記のマクロを開始と終了で分けたいです。
開始する前は画像ファイル上でクリックしても丸は挿入されませんが
開始をして終了を押すまでは丸を挿入できるようにしたいです。
これはできなれば大丈夫です。

まずは画像上でのダブルクリック・・・可能かお願いいたします。

回答No.3

SI299792 · ベストアンサー

このマクロはウインドウ枠の固定や分割を行うと正しく動作しません。
半径は、Radiusの値を変更して下さい。

宣言部（Macro1の上）に以下を追加して下さい。
'　 マウス位置取得
Type PointApi
　　X As Long
　　Y As Long
End Type
Declare Sub GetCursorPos Lib "User32" (lpPoint As PointApi)

Macro0～2 は以前のものをご利用ください。
'
Sub Macro3()
'
　　Const Radius As Long = 50
　　Dim R1C1Left As Long
　　Dim R1C1Top As Long
　　Dim Rect As PointApi
'
　　If Not ShapeSwitch Then
　　　　Exit Sub
　　End If
　　R1C1Left = ActiveWindow.PointsToScreenPixelsX(0) * 0.75 + Radius
　　R1C1Top = ActiveWindow.PointsToScreenPixelsY(0) * 0.75 + Radius
　　GetCursorPos Rect
　　ActiveSheet.Shapes.AddShape(msoShapeOval, _
　　　Rect.X * 0.75 - R1C1Left, _
　　　Rect.Y * 0.75 - R1C1Top, Radius * 2, Radius * 2).Select
　　Selection.ShapeRange.Fill.Visible = msoFalse
　　Selection.ShapeRange.Line.Weight = 1
　　Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, 0)
End Sub

gobou_poo さんの書いた方法はわかりませんでした。できるというのなら、イベントをとる方法だけでも、具体的に書いていただければ、と思います。

お礼

完璧に望み通りのことができました。
本当にありがとうございました。

回答No.2

noname#232800

私は、シェイプを置く場所をセルアドレスで取得し、セルの値変更であればイベントがとれます。
アドレスも、レンジで渡されます。

回答No.1

SI299792

残念ながら、画像をダブルクリックして、マクロ起動する方法はありません。
　画像にマクロを登録しておけば、画像をクリックしての起動は可能ですが、シングルクリックで動いてしまいます。それでよければ、以下のマクロです。

　使い方。
まず、Macro0を実行します。全ての画像にMacro3を登録して、同時に全てのオートシェイプを消します。最初と画像が増えた時に実行します。
Macro1が開始で、Macro2が終了です。ボタンを２つ作って、このマクロを登録しておいて下さい。
Macro3が本体です。
　なお、実行した画像は、マクロの登録を消しています。こうしておかないと、クリックするたびに丸が表示され、何重にもなってしまうからです。したがって、クリックで丸を表示した後、手作業で消し、またクリックしても、〇は表示されません。
'
Option Explicit
'
Dim ShapeSwitch As Boolean
'
Sub Macro0()
'　 初期化（全ての画像にMacro3を登録、オートシェイプを消去）
　　Dim Shape As Object
'
　　For Each Shape In ActiveSheet.Shapes
'
　　　　Select Case Shape.Type
　　　　 Case msoPicture
　　　　　　Shape.OnAction = "Macro3"
　　　　 Case msoAutoShape
　　　　　　Shape.Delete
　　　　End Select
　　Next Shape
End Sub
'
Sub Macro1()
'　 開始
　　ShapeSwitch = True
End Sub
'
Sub Macro2()
'　 終了
　　ShapeSwitch = False
End Sub
'
Sub Macro3()
'
　　If Not ShapeSwitch Then
　　　　Exit Sub
　　End If
'
　　With ActiveSheet.Shapes(Application.Caller)
　　　　ActiveSheet.Shapes.AddShape(msoShapeOval, .Left, .Top, .Width, .Height).Select
　　　　Selection.ShapeRange.Fill.Visible = msoFalse
　　　　Selection.ShapeRange.Line.Weight = 1
　　　　Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, 0)
　　　　.OnAction = ""
　　End With
End Sub

　どうしても、ダブルクリックにしたいのであれば、一定時間内にマウスクリックがあれば実行するという方法がありますが、マウスの動作確認をするプログラムを組み込まなければならず。かなり複雑になります。

補足

すごいです。こんなことができるとは驚きました。
ありがとうございます。

私の質問のしかたがよくなかったのですが
＞ダブルクリックをするとその部分に
というのはマウスポインタを中心にしてという意味でした。
頂いたマクロだと画像を中心にして○が表示されますが
これをマウスポインタを中心にでできますでしょうか？