投稿時間:2006/09/26(Tue) 11:26 投稿者名:YK
Eメール:
URL :
タイトル:Re: EXCEL2000のVBAでIMEHoldを実現する
こんにちは。
ExitとEnterのイベントキャッチの方法です。 終了は必ずフォームから行って下さい。 VBEのリセットをかけるとお化けが出るときが有ります。 コードを見ていただければ説明は不要と思いますので省略します。 実はパクリです。
'クラスモジュール(Class1) Private Declare Function SetTimer Lib "user32" ( _ ByVal Hwnd As Long, ByVal nIDEvent As Long _ , ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Private Declare Sub KillTimer Lib "user32" ( _ ByVal Hwnd As Long, ByVal nIDEvent As Long)
Event EnterControl(ByVal Ctrl As MSForms.Control) Event ExitControl(ByVal Ctrl As MSForms.Control)
Private myForm As UserForm Private myPreActiveControl As MSForms.Control
Private myTimerId As Long
Private Function GetActiveControl( _ ByVal ParentObject As Object) As MSForms.Control Dim myContena As Object Dim myActiveControl As MSForms.Control On Error GoTo LstHdl If TypeName(ParentObject) = "MultiPage" Then Set myContena = ParentObject.SelectedItem Else Set myContena = ParentObject End If Set myActiveControl = myContena.ActiveControl Select Case TypeName(myActiveControl) Case "Frame", "MultiPage" Set myActiveControl _ = GetActiveControl(myActiveControl) End Select Set GetActiveControl = myActiveControl LstHdl: Set myContena = Nothing Set myActiveControl = Nothing End Function
Public Sub CheckActiveControl() Dim myActiveControl As MSForms.Control On Error Resume Next Set myActiveControl = GetActiveControl(myForm) If myActiveControl Is Nothing Then Exit Sub If myActiveControl Is myPreActiveControl Then GoTo LstHdl RaiseEvent ExitControl(myPreActiveControl) RaiseEvent EnterControl(myActiveControl) Set myPreActiveControl = myActiveControl LstHdl: Set myActiveControl = Nothing End Sub
Public Sub Init(ByVal myNewForm As UserForm) Set myForm = myNewForm Set myPreActiveControl = GetActiveControl(myForm) RaiseEvent EnterControl(myPreActiveControl) myTimerId = SetTimer(0&, 0&, 0&, AddressOf TimerProc) End Sub
Private Sub Class_Terminate() KillTimer 0&, myTimerId Set myForm = Nothing Set myPreActiveControl = Nothing End Sub
'標準モジュール Private Declare Sub KillTimer Lib "user32" ( _ ByVal Hwnd As Long, ByVal nIDEvent As Long)
Public Sub TimerProc(ByVal Hwnd As Long _ , ByVal uMsg As Long, ByVal idEvent As Long _ , ByVal dwTime As Long) On Error Resume Next If UserForms.Count = 0 Then KillTimer 0&, idEvent Exit Sub End If UserForm1.EventClass.CheckActiveControl End Sub
'フォームモジュール(UserForm1) Private WithEvents myClass As Class1
Private myCollection As Collection
Public Property Get EventClass() As Class1 Set EventClass = myClass End Property
Private Function CheckControl( _ ByVal Ctrl As MSForms.Control) As Boolean Dim myCtrl As MSForms.Control For Each myCtrl In myCollection If myCtrl Is Ctrl Then Exit For Next CheckControl = Not myCtrl Is Nothing Set myCtrl = Nothing End Function
'Enter時の処理(Ctrlはフォーカスを得たコントロールへの参照) Private Sub myClass_EnterControl(ByVal Ctrl As MSForms.Control) If Not CheckControl(Ctrl) Then Exit Sub Ctrl.BackColor = vbBlack End Sub
'Exit時の処理(Ctrlはフォーカスを得たコントロールへの参照) Private Sub myClass_ExitControl(ByVal Ctrl As MSForms.Control) If Not CheckControl(Ctrl) Then Exit Sub Ctrl.BackColor = vbWhite End Sub
Private Sub UserForm_Activate() Static f As Boolean Dim i As Long
If f Then Exit Sub Set myCollection = New Collection 'イベントをハンドルしたいコントロールへの参照を 'コレクションに追加 With myCollection For i = 1 To 10 .Add Me.Controls("TextBox" & i) Next End With Set myClass = New Class1 myClass.Init Me f = True End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Intege r) Set myClass = Nothing End Sub
|