エクセル2010のvbaについて

Sheet1に挿入したイメージ(ActiveX)をクリックすると数字が上がって
実行中にもう一度同じイメージをクリックすると止まるようにしたいのですが
数字が上がったまま止まりません（上限はあるのでオーバーフローはしません）

Worksheet_SelectionChangeで（ActiveXのイメージがもう一回押されて）
選択セルが変わったら停止としたかったのですが反応しません

イメージをクリック（実行）してもう一回押すとクリックしている間は止まりますが離すと再開されます
コードにクリックされた回数がわかるようにしましたが増えません

説明が分かりにくかったら追記します
回答お願いします


クラスモジュールのコード（イメージの名前によって少し処理を変えるためです）
Private Sub myImg_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim i As Integer, a, b, C As POINTAPI, obj As OLEObject
i = myImg.Index - 1
Call GetCursorPos(C)
Set obj = ActiveWindow.RangeFromPoint(C.X, C.Y)
b = Range("A1")
Range("A1") = obj.Name
Range("A2") = Range("A2") + 1　　　　'クリックされた回数が分かるようにするため追加
If Range("A2") = 2 Then
Range("C1").Select
End If
Range("A3") = "B1"
If obj.Name = 2 Then Range("A3") = "B3"
Range(Range("A3")).Select
End Sub

Sheet1のコード
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Address <> Range(Range("A3")).Address Then Exit Sub
Do While ActiveCell < Range("A4") * 100
If ActiveCell.Address <> Range(Range("A3")).Address Then
Exit Do
End If
DoEvents
ActiveCell = ActiveCell + 1
Loop
End Sub

No.1 ベストアンサー 回答者： mitarashi 回答日時： 2013/01/01 18:33

Set obj = ActiveWindow.RangeFromPoint(C.X, C.Y)によるコントロール名取得について回答したものですが、クラスモジュールでコントロール配列まがいを実現しようとしているのであれば、この方法によるコントロール名取得は不要です。

新年会で酔った頭で遊んでみましたが、リンク先の意味が初めて分かった気がします。まっさらのワークシートにイメージコントロールを2個置いて、当該シートモジュールに記述＋クラスモジュールを2個使用しています。
シートモジュールのtestを実行して下さい。
☆シートモジュール
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private WithEvents myImages As Class2
Dim countFlag As Boolean

Sub test()
Set myImages = New Class2
myImages.add Me.Image1
myImages.add Me.Image2
End Sub

Private Sub myImages_imageClick(myObj As Object)
Select Case myObj.name
Case "Image1"
Me.Range("A2").Value = Me.Range("A2").Value + 1
If countFlag Then
countFlag = False
Else
countFlag = True
countUp
End If
End Select
End Sub

Sub countUp()
Do While countFlag
Me.Range("A3").Value = Me.Range("A3").Value + 1
Sleep 10
DoEvents: DoEvents: DoEvents
Loop
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
countFlag = False
End Sub

☆Class2モジュール
Public Event imageClick(myObj As Object)
Private myImageCls() As Class1

Private Sub Class_Initialize()
ReDim myImageCls(1 To 1)
End Sub

Public Sub add(newImage As msforms.image)
Set myImageCls(UBound(myImageCls)) = New Class1
myImageCls(UBound(myImageCls)).name = newImage.name
Set myImageCls(UBound(myImageCls)).image = newImage
Set myImageCls(UBound(myImageCls)).parent = Me
ReDim Preserve myImageCls(1 To UBound(myImageCls) + 1)
End Sub

Public Sub imageClickProc(myObj As Object)
RaiseEvent imageClick(myObj)
End Sub

☆Class1モジュール
Private WithEvents myImage As msforms.image
Private myName As String
Private myParent As Object

Public Property Set image(newImage As msforms.image)
Set myImage = newImage
End Property

Public Property Let name(newName As String)
myName = newName
End Property

Private Sub myImage_Click()
Call myParent.imageClickProc(myImage)
End Sub

Public Property Set parent(newParent As Object)
Set myParent = newParent
End Property

参考URL：http://www.h3.dion.ne.jp/~sakatsu/Breakthrough_P …

この回答へのお礼

少し遅れてすいません
ありがとうございました

お礼日時：2013/01/04 00:39