恐れ入ります。EXCEL2000のVBAです。

多数のテキストボックスを含むユーザフォームでIMEModeは0(規定値)にしてあります。
ユーザーがあるテキストボックスでIMEをonにしてから次のテキストボックスに入力を
しようとするとIME状態はそのユーザフォームに入ったときの状態に戻ってしまいます。
ある意味使いづらい。AccessのVBAだとIMEHoldプロパティがあり、テキストボックスでの
IME状態を保持してくれるそうですが、EXCEL2000には無いようです。

EXCEL2000でそういう仕様を実現するためには、すべてのテキストボックスについて
「LostFocusイベントでIME状態を記録し、GetFocusイベントでその通り設定する」
とでもしなければならないですか？テキストボックスの数が多い(配列ではない)ので
嫌なんですが。。。

こんばんは
何の案もないんですが、ちょっとやってみました。

> EXCEL2000でそういう仕様を実現するためには、すべてのテキストボックスについて
> 「LostFocusイベントでIME状態を記録し、GetFocusイベントでその通り設定する」
> とでもしなければならないですか？テキストボックスの数が多い(配列ではない)ので
> 嫌なんですが。。。
ホントですね・・・。
Classを作って、イベント処理させようとしても、witheventsは
LostFocus系はサポートしてないみたいだし。
これはきついですね。しこしこ書くしかないんですかね？？？
思いつきません。

>AccessのVBAだとIMEHoldプロパティ
は初めて聞きました。そんなのあるんですねぇ。

何の意味もない書き込みですみません。

> > EXCEL2000でそういう仕様を実現するためには、すべてのテキストボックスについて
> > 「LostFocusイベントでIME状態を記録し、GetFocusイベントでその通り設定する」
GetFocus → GotFocus の間違いだと仮定するにしても、MSForms の場合は、
Enter/Exitイベントだったような気がします。

> Classを作って、イベント処理させようとしても、
この手の処理だと、Class で制御するのが楽ですね。

> witheventsはLostFocus系はサポートしてないみたいだし。
TextBox ではなく、Control のイベントを使うとか。

> これはきついですね。しこしこ書くしかないんですかね？？？
> 思いつきません。
同じく……。

neptune さん、魔界の仮面弁士 さん、どうも有り難うございます。

お２人から引導を渡されるとシコシコやらねばならぬのかなと決心もつきます。
ただ、この仕様は必要性も高く多くのEXCELユーザが問題と思っているだろう/解決策も
既にあるだろうとググってみたんですが、問題提起すら見つかりませんでした。Why？

> GetFocus → GotFocus、Enter/Exitイベント

御意。

> この手の処理だと、Class で制御するのが楽ですね。

同時に「ラベル付テキスト」Classも必要だと思っていますので、合わせて作るならば
作業価値はあるかなぁと。ただ私はまだClassの作成に慣れていなく練習で1,2個作っただけです。
「ラベル付テキスト」の話題はWebでかなり見かけますがサンプルコードが見つかりません。
どこかに無いでしょうか？それの改修なら行けそうです。

こんにちは

> 「ラベル付テキスト」の話題はWebでかなり見かけますがサンプルコードが見つかりません。
> どこかに無いでしょうか？それの改修なら行けそうです。
ラベル付きってのを忘れて作ってしまって書き込もうとしたら
ラベル付きって発見しました。^ ^;
ラベル用子クラスをもうひとつと、Class１にそれ用のコレクションをもうひとつ
作ったら出来ませんかね。

サンプルにもなりませんが、せっかく書いたんでUPしときます。


実験は新規Bookでしてください。
UserFormにTextBoxを３個、コマンドボタンを１個貼り付けてください。名前はデフォルト。
UserForm表示後、マウスカーソルをTextBoxの上を通過させると入力されたデータ
がmsgboxで表示されます。（鬱陶しい！）
ちょっとしか確認してませんので変なところがあったら直してください。

'///////////////////UserForm///////////////////////
Option Explicit

Private clsTxt As Class1

Private Sub CommandButton1_Click()
    With clsTxt
        MsgBox "TextBox1のデータ : " & .Items(1).Text & vbCrLf & _
                "TextBox2のデータ : " & .Items(2).Text & vbCrLf & _
                "TextBox1のデータ : " & .Items(3).Text & _
                "を全て消去します。"
        .EraseAllData
    End With
End Sub

Private Sub UserForm_Initialize()
    Set clsTxt = New Class1
    clsTxt.AddItem = Me.TextBox1
    clsTxt.AddItem = Me.TextBox2
    clsTxt.AddItem = Me.TextBox3
    Me.CommandButton1.Caption = "全データ消去"
End Sub

Private Sub UserForm_Terminate()
    Set clsTxt = Nothing
End Sub

'///////////////////////////Class1/////////////////
Option Explicit

Private clsItem As Class2
Private mCollection As Collection

Public Property Let AddItem(ptxt As MSForms.TextBox)
    Set clsItem = New Class2
    Set clsItem.SetTextBox = ptxt
    mCollection.Add clsItem
End Property

Public Property Get Items(pNum As Long) As MSForms.TextBox
    Set Items = mCollection(pNum).GetTextBox
End Property

'全てのデータ消去
Public Function EraseAllData()
Dim clsBuf As Class2
Dim I As Long

    For I = 1 To mCollection.Count
        mCollection(I).DelText
    Next I
End Function
Private Sub Class_Initialize()
    Set mCollection = New Collection
End Sub

Private Sub Class_Terminate()
    Set mCollection = Nothing
End Sub

'////////////////////////Class2/////////////////////
Option Explicit

Private WithEvents mTxt As MSForms.TextBox


Property Set SetTextBox(ptxt As MSForms.TextBox)
    Set mTxt = ptxt
End Property

Property Get GetTextBox() As MSForms.TextBox
    Set GetTextBox = mTxt
End Property

Public Function DelText()
    mTxt.Text = ""
End Function

Private Sub Class_Terminate()
    Set mTxt = Nothing
End Sub

Private Sub mTxt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    MsgBox mTxt.Text
End Sub

neptune さん、サンプルどうもありがとうございます。参考にして下記を試してみました。

'///////////////////Module1///////////////////////
Public IMEstatus As Integer

'///////////////////UserForm///////////////////////
Option Explicit
Private clsTxt As Class3

Private Sub CommandButton1_Click()
    With clsTxt
        MsgBox "TextBox1のIME : " & .Items(1).IMEMode & vbCrLf & _
               "TextBox2のIME : " & .Items(2).IMEMode & vbCrLf & _
               "TextBox3のIME : " & .Items(3).IMEMode & vbCrLf
    End With
End Sub

Private Sub UserForm_Initialize()
    Set clsTxt = New Class3
    clsTxt.AddItem = Me.TextBox1
    clsTxt.AddItem = Me.TextBox2
    clsTxt.AddItem = Me.TextBox3
End Sub

Private Sub UserForm_Terminate()
    Set clsTxt = Nothing
End Sub

'///////////////////////////Class3/////////////////
Option Explicit

Private clsItem As Class4
Private mCollection As Collection

Public Property Let AddItem(ptxt As MSForms.TextBox)
    Set clsItem = New Class4
    Set clsItem.SetTextBox = ptxt
    mCollection.Add clsItem
End Property

Public Property Get Items(pNum As Long) As MSForms.TextBox
    Set Items = mCollection(pNum).GetTextBox
End Property

Private Sub Class_Initialize()
    Set mCollection = New Collection
End Sub

Private Sub Class_Terminate()
    Set mCollection = Nothing
End Sub

'////////////////////////Class4/////////////////////
Option Explicit

Private WithEvents mTxt As MSForms.TextBox

Property Set SetTextBox(ptxt As MSForms.TextBox)
    Set mTxt = ptxt
End Property

Property Get GetTextBox() As MSForms.TextBox
    Set GetTextBox = mTxt
End Property

Private Sub Class_Terminate()
    Set mTxt = Nothing
End Sub

Private Sub mTxt_Enter()
    mTxt.IMEMode = IMEstatus
End Sub

Private Sub mTxt_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    IMEstatus = mTxt.IMEMode
End Sub

問題点：mTxt_EnterとmTxt_Exitイベントが発生しません。ネットで調べてみると
「テキストボックス(MSForms.TextBox)をクラス化しても「Enter」や「Exit」のイベントはトラップできません。」（orz）
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_100_040.html

このページにその対策が書いてあるようなのですが、現時点で理解できていません！！
土日にじっくり考えて見ますね。（いや1週間はかかるかも）

こんにちは
> neptune さん、サンプルどうもありがとうございます。参考にして下記を試してみました。
> 問題点：mTxt_EnterとmTxt_Exitイベントが発生しません。ネットで調べてみると
> 「テキストボックス(MSForms.TextBox)をクラス化しても「Enter」や「Exit」のイベントはトラップできません。」（orz）
> http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_100_040.html
いや〜お恥ずかしい。
UPした後で考えるとダンボさんにこのようなクラスのサンプルは必要ないですよね。
実は、削除しようかなと思っていました。
「Enter」や「Exit」の件ですが、これは仕様ですからねぇ。

それと、リンクのページ見てみましたが、対策はDo〜Loopでずっと監視している
という手法らしいですが、Doeventsはかましているんですが、これで実用上問題は
出ないのでしょうか？？個人的には実用には充分な検証が必要じゃないかと思います。

動的にコントロールを作るとすれば、欲しい所ですが・・・。

かなり面倒ですが、監視用の外部Dllなんぞを作って、定期的にActiveContolの
IMEをチェックするとかしか浮かびません。（出来るかどうかは多分出来そう低度です)
　APIのSetTimerをVBAで使うのは以前実験だけですが、一応動きはしますが、
痛い目を食らったことがありますからNGです。確かExcel君がお亡くなりに
なったのかな？記憶喪失。

書いてUPしたもののつらつら考えるに
「ラベル付テキスト」とは、全く違うものじゃないかと思い始めました。
ユーザーコントロールのことかな？
恥ずかし。理解力のなさ。

ま、どなたかの役に立つかもしれないので、消さずにおきます。

> 「ラベル付テキスト」とは、全く違うものじゃないかと思い始めました。
> ユーザーコントロールのことかな？

済みません。私の言葉足らずで誤解させたかも知れません。
「ラベルコントロール付きテキストボックス」の意味です。

「項目名が左側にあって対応する入力ボックスがすぐ右側にある」というGUIはありがちです。
（項目名のすぐ下に入力ボックスでもいいんですが）
これをVB/VBAのデザイナで配置すると手間が2倍、コントロール名も2倍になってしまうので
ある程度の制限でラベルとテキストボックスを組にしたコントロールが欲しいな。と。

こんにちは。

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

YK さん、どうも有り難うございます。

ＭＳさんがIMEHoldを用意してくれなかったために結構面倒なことになっていますね。

> ExitとEnterのイベントキャッチの方法です。

私のツールの使用者に対しては「ＭＳの仕様だから」で押し通していますので、
ご提示いただいたコードについてはゆるゆると実験して行きたいと思います。
完了報告までは出せないと思いますがお許し下さい。

ところで皆さん、一連のスレッドに書いた「ラベルコントロール付きテキストボックス」は
「だるま」さんの方法で何とか行けるのではないかと、今実験中です。
http://members3.jcom.home.ne.jp/daruma_kyo/class/index.html

こんにちは

YKさんの
> > ExitとEnterのイベントキャッチの方法です。
ですが、前にも書きましたが、SetTimerは使用を慎重にして下さい。
UserFrom以外のExcelにフォーカスが移る場合には使用できないと思って下さい。
例えば、ワークシートにフォーカスがあるときSerTimerを使用すると、
Timerイベントが発生するたびに、例えばExcelがチカチカしたりします。
それと、MSが自分で、言っているように、グローバル変数はいつ無効になるか
わかりません。（YKさんのは使ってないようですが）
・・・ExcelでSerTimerは使わない！
これは何年も前にいじくり倒して得た経験値です。^ ^;;;

YKさん＞
別に難癖つけてるんじゃないですから、誤解のない様にお願いします。

> 私のツールの使用者に対しては「ＭＳの仕様だから」で押し通していますので、
> ご提示いただいたコードについてはゆるゆると実験して行きたいと思います。
それは↑の問題で是非そうした方が安全と思います。

> ところで皆さん、一連のスレッドに書いた「ラベルコントロール付きテキストボックス」は
> 「だるま」さんの方法で何とか行けるのではないかと、今実験中です。
> http://members3.jcom.home.ne.jp/daruma_kyo/class/index.html
ササッと見てみましたが、ササッとでは良くわからんでした。

所で、doevents連発監視の方はやはり・・・・どうなんですかね？
怖いもの見たさだけなんですが、もし検証したのなら教えてくださいね。m(_ _)m