こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

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

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

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

投稿日時 - 2018-02-28 23:34:35

QNo.9433784

困ってます

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

このマクロはウインドウ枠の固定や分割を行うと正しく動作しません。
半径は、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 さんの書いた方法はわかりませんでした。できるというのなら、イベントをとる方法だけでも、具体的に書いていただければ、と思います。

投稿日時 - 2018-03-02 04:41:51

お礼

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

投稿日時 - 2018-03-02 07:22:46

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(3)

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

投稿日時 - 2018-03-01 08:07:09

ANo.1

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

 使い方。
まず、Macro0を実行します。全ての画像にMacro3を登録して、同時に全てのオートシェイプを消します。最初と画像が増えた時に実行します。
Macro1が開始で、Macro2が終了です。ボタンを2つ作って、このマクロを登録しておいて下さい。
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

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

投稿日時 - 2018-03-01 07:45:55

補足

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

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

投稿日時 - 2018-03-01 08:42:43

あなたにオススメの質問