[[20140908144924]] 『ユーザーフォームモードレスでフォーカスを戻す』(あすな) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『ユーザーフォームモードレスでフォーカスを戻す』(あすな)

 ユーザーフォームをモードレスで開き、必須入力があるため
 Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Len(TextBox1.Value) = 0 Then
        MsgBox "納品希望日を入力してください"
        Cancel = True
    End If
 End Sub

 としました。ですが、フォーカス?カーソル?が戻らず、色々試してみたら、
 UserForm1.Show vbModeless
 このモードレスがないとちゃんとカーソルが戻りました。
 モードレスでかつ、未入力のTextBox1にカーソルが移動しないようにしたいのですが、
 どうすればよいのでしょうか?
 ご教示お願いいたします。

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Len(TextBox1.Value) = 0 Then
        MsgBox "納品希望日を入力してください"
        SendKeys "+{tab}"
    End If
End Sub
(???) 2014/09/08(月) 15:56

 ???さん回答ありがとうございました。

 後出しですみません。もうちょっと教えてください。

 TextBox1だけでしたら、教えていただいたコードで希望通りでしたが、実は次に2つ必須入力が続きます。

 教えていただいた通り、Cancel = True を SendKeys "+{tab}" に3つのtextbox分を変更し、
 未入力で動かそうとしたら

 textbox1(TABキーで飛ばそうとする)→ msgbox「納品希望日・・・」表示 → OKクリック →
 TexrBox2のMsgBox表示 → OKクリック → TextBox1の「納品希望日・・・」再度表示 → OKクリック
 その後カーソルは見当たりません。

 連続する場合は他にも注意が必要でしたか?
 TextBox1→2→1という動きも理解できません。
 よろしくお願いいたします。
(あすな) 2014/09/08(月) 17:17

 要件はTextBox1のExit後に
 > 未入力のTextBox1にカーソルが移動しないようにしたい
で良いんです?
    Cancel = True
の記述を削除するだけじゃダメですか。
(ご近所PG) 2014/09/08(月) 17:28

 ご近所PGさん、回答ありがとうございます。

 Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Len(TextBox1.Value) = 0 Then
        MsgBox "納品希望日"を入力してください"
    End If
 End Sub
 これだと、 MsgBox をOKすると、次のTextBox2にカーソルが行ってしまいます。
 必須なので、入力なければそのままTextBox1にとどまってほしいです。

(あすな) 2014/09/08(月) 17:39


入力時に判定するのは、SetFocusが思ったように動いてくれない問題があって、難しいのです。
できれば、「実行」ボタン等を押したときに入力判定するのが簡単です。

とりあえず、無理矢理入力判定してみる例。

Dim iFlag As Long

 Private Sub TextBox1_Enter()
    If iFlag = 0 Then
        iFlag = 1
    End If
End Sub

 Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Len(TextBox1.Value) = 0 Then
        If iFlag = 1 Then
            MsgBox "納品希望日を入力してください"
            SendKeys "+{tab}"
        End If
    Else
        iFlag = 0
    End If
End Sub

 Private Sub TextBox2_Enter()
    If iFlag = 0 Then
        iFlag = 2
    End If
End Sub

 Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Len(TextBox2.Value) = 0 Then
        If iFlag = 2 Then
            MsgBox "納品希望日を入力してください"
            SendKeys "+{tab}"
        End If
    Else
        iFlag = 0
    End If
End Sub
(???) 2014/09/08(月) 18:11

 ???さんありがとうございます!
 思い通りに動いたので、こちらを使用させていただきます。
 大変助かりました。
 ありがとうございました。
(あすな) 2014/09/08(月) 18:35

 私がモドレスモードのExitイベント等でMsgbox表示後、フォーカスが表示されない案件に関しての
 対処法です。

 標準モジュールに

 '=============================================================================
 Sub ctrl_SetFocus(ByVal frmnm As String, ByVal ctrlnm As String)
    Dim frm As Object
    For Each frm In UserForms
       If UCase(frm.Name) = UCase(frmnm) Then
          frm.Controls(ctrlnm).SetFocus
          Exit For
       End If
    Next
 End Sub

 ユーザーフォームのExitイベントでは、

 '===========================================================================
 Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    With TextBox1
       If Len(.Value) = 0 Then
          MsgBox "納品希望日を入力してください"
          Application.OnTime Now(), "'ctrl_SetFocus """ & Me.Name & """,""TextBox1""'"
       End If
    End With
 End Sub

 これで対処する事が考えつきます(Cancel=Trueは、入れないところがポイント)。

 これは、私からの提案です。
 上記は、何度かこのような掲示板で質問があったので、色々試行錯誤の結果ですが、

 実際には、私は使っていません。使用頻度の高いユーザーフォームでこのMsgBoxって、
 ウザイ(初めて記述しました)というか しつこい というか ボタンクリックするのも面倒です。

 と よく私のユーザーからは、言われました。

 私は、このエラーメッセージは、ユーザーフォームの下の方にラベルを体裁よく配置し、
 そこに表示するようにしています。気が付きにくければ、2,3回 背景色を使ってブリンクすればよいです。

 Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    With TextBox1
       If Len(.Value) = 0 Then
          label1.caption= "納品希望日を入力してください"
          cancel=true
       End If
    End With
 End Sub

 そうすれば、普通に Cancel=True でOKです。

 検討してみてください

(ichinose) 2014/09/08(月) 18:37


 ???さんのコードを拝見して気が付きました。
 別のコントロールのExitイベントがひっかかってしまうのですね!!では、
 Private ev As Boolean
 Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If ev Then ev = False: Exit Sub
    ev = True
    With TextBox1
       If Len(.Value) = 0 Then
          MsgBox "納品希望日を入力してください"
          Application.OnTime Now(), "'ctrl_SetFocus """ & Me.Name & """,""TextBox1""'"
       Else
          ev = False
       End If
    End With
 End Sub
 Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If ev Then ev = False: Exit Sub
    ev = True
    With TextBox2
       If Len(.Value) = 0 Then
          MsgBox "納品希望日を入力してください"
          Application.OnTime Now(), "'ctrl_SetFocus """ & Me.Name & """,""TextBox2""'"
       Else
          ev = False
       End If
    End With
 End Sub
 Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If ev Then ev = False: Exit Sub
    ev = True
    With TextBox3
       If Len(.Value) = 0 Then
          MsgBox "納品希望日を入力してください"
          Application.OnTime Now(), "'ctrl_SetFocus """ & Me.Name & """,""TextBox3""'"
       Else
          ev = False
       End If
    End With
 End Sub

 フラグを使うしかなさそうですが、他のコントロールにも気を配らなければならないので大変そうです。

 やっぱり、エラーメッセージは ラベル表示 で検討してみては?

(ichinose) 2014/09/09(火) 06:52


 >> 要件はTextBox1のExit後に
 >>> 未入力のTextBox1にカーソルが移動しないようにしたい
 >>で良いんです?
 > 必須なので、入力なければそのままTextBox1にとどまってほしいです。
 
やっぱり「TextBox1【から】カーソルが移動しないように」が正解ですよね。
 
で、皆さんの回答が出た後ですが、別案として……
 
VBには無くてExcelのFormだと以下の様なイベントもあったりします。
    TextBox1_BeforeUpdate
Exit前に動くイベントです。
ただ、更新されないと動かないという面があるので、ちょっと小細工して
 
Option Explicit
Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    If Len(TextBox1.Value) = 0 Then
        MsgBox "納品希望日1を入力してください"
        Cancel = True
    End If
End Sub
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    If Len(TextBox2.Value) = 0 Then
        MsgBox "納品希望日2を入力してください"
        Cancel = True
    End If
End Sub
Private Sub TextBox3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    If Len(TextBox3.Value) = 0 Then
        MsgBox "納品希望日3を入力してください"
        Cancel = True
    End If
End Sub
'BeforeUpdateを起動させるためのおまじない
Private Sub TextBox1_Enter()
    Call DummyUpdate(TextBox1)
End Sub
Private Sub TextBox2_Enter()
    Call DummyUpdate(TextBox2)
End Sub
Private Sub TextBox3_Enter()
    Call DummyUpdate(TextBox3)
End Sub
Private Sub DummyUpdate(ByVal Target As MSForms.TextBox)
    Dim preValue As String
    preValue = Target.Text  '現在の値を保持
    Target.Text = vbTab     '通常操作では入力できないであろう文字で更新
    Target.Text = preValue  '元に戻す
End Sub
 
そもそもExitさせない的な。
※10:10 少し修正
(ご近所PG) 2014/09/09(火) 09:57

 うわ、ichinoseさん、ご近所PGさん気づきませんでした。ありがとうございます。
 私もmsgboxのクリック嫌いです。ラベル案を試してみます。

 ご近所PGさん、日本語を間違っていたのに今気づきました。すみませんorz
 そもそもExitさせない方法もやってみます。
 みなさんありがとうございました。

 すみません、色々案を出していただいて満足なのですが、
 ご近所PGさんのを今試したら、やっぱりカーソルが消えたままでして・・・。
 せっかく案をいただいたので、自分でももっと試してみます。
 ありがとうございました。

(あすな) 2014/09/09(火) 16:38


 oh...イベント連鎖の回避に目が行って肝要なところが抜け落ちていた。申し訳ないです。
そんなイベントもあるんだねってくらいの参考で。
 
問題の解決については、ちょっと調べたけれどラベル案に一票です。
(ご近所PG) 2014/09/09(火) 17:13

 >ラベル案を試してみます
 エラーメッセージに関しては、ユーザーフォームのモーダル・モーダレスに関わらず、私は、
 これを使っているので、あすなさんの事象に関しては、これがよいと思います。

 ただ、Msgboxも何かでは必要になりますよね!!

 このスレッドに関係したおかげでいくつかの新発見があったので記述しておきます。

 ユーザーフォームのモーダレス表示時のMsgboxでエラーメッセージ表示後のテキストボックスへのカーソルが消えるという現象。
 仮にテキストボックスを3つ配置した場合(Textbox1、Textbox2、Textbox3)、

 前回の投稿の

 >標準モジュールに
 >'=============================================================================
 >Sub ctrl_SetFocus(ByVal frmnm As String, ByVal ctrlnm As String)
 >   Dim frm As Object
 >   For Each frm In UserForms
 >      If UCase(frm.Name) = UCase(frmnm) Then
 >         frm.Controls(ctrlnm).SetFocus
 >         Exit For
 >      End If
 >   Next
 >End Sub

 ユーザーフォーム(Userform1)のモジュールに

 >Private ev As Boolean
 >Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 >   If ev Then ev = False: Exit Sub
 >   ev = True
 >   With TextBox1
 >      If Len(.Value) = 0 Then
 >         MsgBox "納品希望日を入力してください"
 >         Application.OnTime Now(), "'ctrl_SetFocus """ & Me.Name & """,""TextBox1""'"
 >      Else
 >         ev = False
 >      End If
 >   End With
 >End Sub
 >Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 >   If ev Then ev = False: Exit Sub
 >   ev = True
 >   With TextBox2
 >      If Len(.Value) = 0 Then
 >         MsgBox "納品希望日を入力してください"
 >         Application.OnTime Now(), "'ctrl_SetFocus """ & Me.Name & """,""TextBox2""'"
 >      Else
 >         ev = False
 >      End If
 >   End With
 >End Sub
 >Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 >   If ev Then ev = False: Exit Sub
 >   ev = True
 >   With TextBox3
 >      If Len(.Value) = 0 Then
 >         MsgBox "納品希望日を入力してください"
 >         Application.OnTime Now(), "'ctrl_SetFocus """ & Me.Name & """,""TextBox3""'"
 >      Else
 >         ev = False
 >      End If
 >   End With
 >End Sub

 でうまく作動すると思っていたのですが・・・・。

 正常に作動するのは、VBE側から起動た場合、いえ、VBEが起動された状態であれば、Excel側から
 実行しても正常に作動します。が、一度、Excel本体を閉じて改めて、当該ブックを開いたのち、
 VBEの起動なしに実行すると、上記のコードでは、エラーメッセージ表示後、正しくテキストボックスに
 カーソルが戻りませんでした。結構、厄介な案件です。掲示板の質問時のテストでは、VBEから起動するので
 気が付きませんでした。

 で、標準モジュールのctrl_SetFocusというコード内で対象コントロールに刺激を与えて
 反応を見てみたのですが・・・。ご近所PGさんのDummyUpdateを真似てみました。

 '=============================================================================
 Sub ctrl_SetFocus(ByVal frmnm As String, ByVal ctrlnm As String)
    Dim frm As Object
    Dim wk As String
    For Each frm In UserForms
       If UCase(frm.Name) = UCase(frmnm) Then
          With frm.Controls(ctrlnm)
             wk = .Value
             .Value = vbCrLf
             .Value = wk
             .SetFocus
          End With
          Exit For
       End If
    Next
 End Sub

 上記のように変更して試してみると、今度は、VBEが起動状態でなくても
 エラーメッセージ表示後、所定の位置にカーソルが点滅しました。

(ichinose) 2014/09/10(水) 06:29


 ichinoseさん

 びっくりしました!戻りました!
 ラベル案を通してしまったので、頂いたコードは次回まで大切にとっておきます。
 本当にありがとうございました。
(あすな) 2014/09/10(水) 13:12

 お邪魔します。

 この件は10年以上修正されてないので
 バグって言うより、もう「仕様」に近いですね。

 MsgBox案ですと、表示後に対象コントロールを
 クリックさせる方法がExitイベントの意味として妥当だと思いますよ。

 でもやっぱりMsgBoxでのお知らせをやめる案がユーザーに優しいですね。
(Abyss) 2014/09/10(水) 13:28

'============================================
'UserForm1.Show vbModeless
'============================================
'Me.TextBox1.TabIndex = 0
'Me.TextBox2.TabIndex = 1
'Me.Label1.Caption : ErrorMessage
'=====================================
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If (KeyCode = vbKeyReturn) Then
        KeyCode = 0 ' Cancel [Enter] Key (Enter Key Only)
        If (UCase(Me.TextBox1.Value) = "TODAY" Or Me.TextBox1.Value = "今日") Then
            Me.TextBox1.Value = Format(Date, "yyyy/mm/dd")
        End If
        If (UCase(Me.TextBox1.Value) = "YESTERDAY" Or Me.TextBox1.Value = "昨日") Then
            Me.TextBox1.Value = Format(DateAdd("d", -1, Date), "yyyy/mm/dd")
        End If
        If (UCase(Me.TextBox1.Value) = "TOMORROW" Or Me.TextBox1.Value = "明日") Then
            Me.TextBox1.Value = Format(DateAdd("d", 1, Date), "yyyy/mm/dd")
        End If
        If (Len(Me.TextBox1.Value) = 0 Or IsDate(Me.TextBox1.Value) = False) Then
            '<Label>
            Me.Label1.ForeColor = &HFF&
            Me.Label1.Caption = "納品希望日を入力してください"
            '<Msgbox>
            MsgBox "納品希望日を入力してください"
            'FocusControl
            Me.TextBox2.SetFocus ' Next Focus (Dummy Focus)
            Me.TextBox1.SetFocus ' NG: Go Back
       Else
            Me.TextBox1.Value = Format(Me.TextBox1.Value, "yyyy/mm/dd") ' Change : yyyy/mm => yyyy/mm/01
            Me.Label1.ForeColor = &H80000008
            Me.Label1.Caption = "" 
            Me.TextBox2.SetFocus ' OK: Next Focus
       End If
    End If
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Not Used
End Sub

(Today) 2016/04/30(土) 13:37


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.