SHOJI's Code
 仕事や趣味で書いた各種言語のプログラミングコード(エクセルVBA,PHP,C/C++/C#,JavaScript等)、その他雑記。
2017.10<<123456789101112131415161718192021222324252627282930>>2017.12
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

デスクトップを整理していたら、テスト的に書いたマクロが出てきた。
とりあえず、載せておく。
クラスモジュール CellEvents
Private Cell As Range
Private WithEvents Sheet As Worksheet

Private IsSelected As Boolean

Public Event Activated()
Public Event Deactivated()

Public Event Enter()
Public Event Leave()

Public Event Change()

Public Event Calculate()

Public Event BeforeDoubleClick(Cancel As Boolean)
Public Event BeforeRightClick(Cancel As Boolean)

Public Sub Initialize(ByVal c As Range)
If c.Count > 1 Then Err.Raise Number:=1000, Description:="単一のセルでなければなりません"

Set Cell = c
Set Sheet = c.Worksheet

IsSelected = IsIncluded(Selection)
End Sub

Private Sub Sheet_Activate()
IsSelected = IsIncluded(Selection)
RaiseEvent Activated
End Sub

Private Sub Sheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If IsIncluded(Target) Then RaiseEvent BeforeDoubleClick(Cancel)
End Sub

Private Sub Sheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If IsIncluded(Target) Then RaiseEvent BeforeRightClick(Cancel)
End Sub

Private Sub Sheet_Calculate()
RaiseEvent Calculate
End Sub

Private Sub Sheet_Change(ByVal Target As Range)
If IsIncluded(Target) Then RaiseEvent Change
End Sub

Private Sub Sheet_Deactivate()
RaiseEvent Deactivated
End Sub

Private Sub Sheet_SelectionChange(ByVal Target As Range)
CheckSelection IsIncluded(Target)
End Sub

Private Sub CheckSelection(ByVal state As Boolean)
Dim b As Boolean
b = IsSelected
IsSelected = state
If Not b And IsSelected Then RaiseEvent Enter
If b And Not IsSelected Then RaiseEvent Leave
End Sub

Private Function IsIncluded(ByVal r As Range) As Boolean
On Error Resume Next
IsIncluded = Not (Intersect(r, Cell) Is Nothing)
End Function



このクラスのインスタンスを作成し、Initializeメソッドでセルを登録すれば、以後、そのセルに関するイベントが使用できるというものである。

使い方としては、こんな感じ
Dim WithEvents X As CellEvents

Sub test()
Set X = New CellEvents
X.Initialize Sheet1.Range("A1")
End Sub

Private Sub X_Activated()
MsgBox "Activated!"
End Sub

Private Sub X_BeforeDoubleClick(Cancel As Boolean)
MsgBox "Double Clicked!"
End Sub

Private Sub X_BeforeRightClick(Cancel As Boolean)
MsgBox "Right Clicked!"
End Sub

Private Sub X_Calculate()
MsgBox "Calculated!"
End Sub

Private Sub X_Change()
MsgBox "Changed!"
End Sub

Private Sub X_Deactivated()
MsgBox "Deactivated"
End Sub

Private Sub X_Enter()
MsgBox "Entered!"
End Sub

Private Sub X_Leave()
MsgBox "Leaved!"
End Sub



テーマ:エクセル - ジャンル:コンピュータ
コメント
この記事へのコメント
コメントを投稿する

管理者にだけ表示を許可する
トラックバック
この記事のトラックバックURL
この記事へのトラックバック
copyright © 2004-2006 SHOJI, Powered By FC2ブログ all rights reserved.
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。