none
(VBA) TextBox1_KeyPress名を動的に扱う RRS feed

  • 質問

  • Windows7(32bit)-Excle2010を使用しています。

    例えば"UserFoam1"に"TextBox"が20個あるとします。
    そして数字キーだけが入力可能なテキストボックスを作成する場合、
    非力な私の場合は、下記のSubステートメントを20組分書き連ねる事になります。
    例えば、共通の「TextBoxAA_KeyPress」を用意し動的に処理する構文の作成は可能でしょうか?。
    サンプルコードを提示てただければ大助かりなのですが、
    ご教授宜しくお願い致します。
    -----------------------------
    Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        If KeyAscii < Asc(0) Or KeyAscii > Asc(9) Then
            KeyAscii = 0
        End If
    End Sub
    -----------------------------
    以上


    • 編集済み sakuraxx 2014年5月30日 23:11 タイトル[VBA]⇒(VBA)に変更
    2014年5月29日 8:06

回答

  • ⇒「数式が複雑すぎます。オブジェクトに登録する事はできません。」
    今回のケースは、ボタン等にマクロの登録はできないのでしょうか?

    試した限りでは、マクロのあるEXCELファイルの名前やフォルダ名に半角の括弧[]があるとファイル名をうまく認識できないためにこのエラーが出るようです。

    たとえばC:\Test\A[.xlsとか。
    ファイルやフォルダ名に記号が混ざっているなら、一時的にフォルダを移動してみたり名前を変更してみてください。

    #もう一個の質問の方にご自身の返信のみを回答としていますが、役に立ちませんでした?


    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)


    • 編集済み gekkaMVP 2014年5月30日 15:08
    • 回答としてマーク sakuraxx 2014年5月30日 23:23
    2014年5月30日 15:07
  • こんな

    'UserForm1のコード
    Option Explicit
    
    Private textBoxCollection As New Collection 'イベントを受け取るクラスを保存しておくためのコレクション
    
    Private Sub UserForm_Initialize()
        Dim ctl As Control
        For Each ctl In Me.Controls
            If (Left(ctl.Name, 7) = "TextBox") Then 'TextBox○○という名前のコントロールを探す
                Dim txb As MSForms.textBox
                Set txb = ctl
                
                Dim sink As TextBoxChangedSink '下に記述してあるクラスモジュールの名前を参照する
                Set sink = New TextBoxChangedSink 'TextBoxのイベントを受け取るためのクラスを作る
                Call sink.Init(txb, Me) 'TextBoxとこのUserFormを登録する
                
                Dim key As String
                key = CInt(Mid(ctl.Name, 8))
                Call textBoxCollection.Add(sink, key) 'イベントが消えないように保持する
            End If
        Next
    End Sub
    
    Public Sub OnKeyPress(ByVal textBox As MSForms.textBox, ByVal KeyAscii As MSForms.ReturnInteger) 'イベントが発生したTextBoxが引数として渡されてくる
       If KeyAscii < Asc(0) Or KeyAscii > Asc(9) Then
            KeyAscii = 0
        End If
    End Sub
    
    'クラスモジュールのコード
    '名前は適当でいいが、とりあえずオブジェクト名にTextBoxChangedSinkという名前を付ける
    Option Explicit
    
    Private WithEvents txb1 As MSForms.textBox 'イベントが発生するTextBox
    Private uf1 As UserForm1
    
    'イベントが発生するTextBoxと発生したことを通知するUserFormを登録する
    Public Sub Init(ByVal txb As MSForms.textBox, ByVal uf As UserForm1)
        Set txb1 = txb
        Set uf1 = uf
    End Sub
    
    'このクラスに登録されたTextBoxで発生した_KeyPressイベントを受け取る
    Private Sub txb1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        If (uf1 Is Nothing) Then
            Return
        End If
        Call uf1.OnKeyPress(txb1, KeyAscii) 'イベントが発生したらUserForm1の関数を呼び出す
    End Sub
    


    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    • 回答としてマーク sakuraxx 2014年5月30日 23:24
    2014年5月29日 11:03
  • 同じ処理を行わせるならクラスに共通コードを置きます。

    Option Explicit
    'モジュールに作る
    Public Function CreateTextBoxEvent(ByVal uf As UserForm, ByVal name As String) As Collection
        Dim textBoxCollection As New Collection 'イベントを受け取るクラスを保存しておくためのコレクション
        Dim ctl As Control
        For Each ctl In uf.Controls
            If (Left(ctl.name, Len(name)) = name) Then 'TextBox○○という名前のコントロールを探す
                Dim txb As MSForms.textBox
                Set txb = ctl
                
                Dim sink As TextBoxChangedSink '下に記述してあるクラスモジュールの名前を参照する
                Set sink = New TextBoxChangedSink 'TextBoxのイベントを受け取るためのクラスを作る
                Call sink.Init(txb, uf) 'TextBoxとこのUserFormを登録する
    
                Dim key As String
                key = CInt(Mid(ctl.name, 8))
                Call textBoxCollection.Add(sink, key) 'イベントが消えないように保持する
            End If
        Next
        
        Set CreateTextBoxEvent = textBoxCollection
    End Function
    'クラスモジュールのコード
    '名前は適当でいいが、とりあえずオブジェクト名にTextBoxChangedSinkという名前を付ける
    Option Explicit
    
    Private WithEvents txb1 As MSForms.textBox 'イベントが発生するTextBox
    Private uf1 As UserForm
    
    'イベントが発生するTextBoxと発生したことを通知するUserFormを登録する
    Public Sub Init(ByVal txb As MSForms.textBox, ByVal uf As UserForm)
        Set txb1 = txb
        Set uf1 = uf
    End Sub
    
    'このクラスに登録されたTextBoxで発生した_KeyPressイベントを受け取る
    Private Sub txb1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        If (uf1 Is Nothing) Then
            Return
        End If
        
        If KeyAscii < Asc(0) Or KeyAscii > Asc(9) Then
            KeyAscii = 0
        End If
    End Sub

    として、各UserFormで以下のように使います。

    'UserForm1のコード
    Option Explicit
    Private textBoxCollection As Collection
    Private Sub UserForm_Initialize()
        Set textBoxCollection = CreateTextBoxEvent(Me, "TextBox")
    End Sub
    




    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    • 回答としてマーク sakuraxx 2014年5月30日 23:23
    2014年5月30日 3:58

すべての返信

  • こんな

    'UserForm1のコード
    Option Explicit
    
    Private textBoxCollection As New Collection 'イベントを受け取るクラスを保存しておくためのコレクション
    
    Private Sub UserForm_Initialize()
        Dim ctl As Control
        For Each ctl In Me.Controls
            If (Left(ctl.Name, 7) = "TextBox") Then 'TextBox○○という名前のコントロールを探す
                Dim txb As MSForms.textBox
                Set txb = ctl
                
                Dim sink As TextBoxChangedSink '下に記述してあるクラスモジュールの名前を参照する
                Set sink = New TextBoxChangedSink 'TextBoxのイベントを受け取るためのクラスを作る
                Call sink.Init(txb, Me) 'TextBoxとこのUserFormを登録する
                
                Dim key As String
                key = CInt(Mid(ctl.Name, 8))
                Call textBoxCollection.Add(sink, key) 'イベントが消えないように保持する
            End If
        Next
    End Sub
    
    Public Sub OnKeyPress(ByVal textBox As MSForms.textBox, ByVal KeyAscii As MSForms.ReturnInteger) 'イベントが発生したTextBoxが引数として渡されてくる
       If KeyAscii < Asc(0) Or KeyAscii > Asc(9) Then
            KeyAscii = 0
        End If
    End Sub
    
    'クラスモジュールのコード
    '名前は適当でいいが、とりあえずオブジェクト名にTextBoxChangedSinkという名前を付ける
    Option Explicit
    
    Private WithEvents txb1 As MSForms.textBox 'イベントが発生するTextBox
    Private uf1 As UserForm1
    
    'イベントが発生するTextBoxと発生したことを通知するUserFormを登録する
    Public Sub Init(ByVal txb As MSForms.textBox, ByVal uf As UserForm1)
        Set txb1 = txb
        Set uf1 = uf
    End Sub
    
    'このクラスに登録されたTextBoxで発生した_KeyPressイベントを受け取る
    Private Sub txb1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        If (uf1 Is Nothing) Then
            Return
        End If
        Call uf1.OnKeyPress(txb1, KeyAscii) 'イベントが発生したらUserForm1の関数を呼び出す
    End Sub
    


    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    • 回答としてマーク sakuraxx 2014年5月30日 23:24
    2014年5月29日 11:03
  • gekkaさん、早々のご回答有難うございます。
    早速試行させていただきました…目的道理の動作でした…感謝
    非力な私には自力で作成できない素晴らしいコードでした。
    まだ内容を完璧に把握できた訳ではないのですが、
    解りやすいコメントを添えていただけたので概ね理解する事ができました。
    《追加確認》
    UserForm2 とか UserForm3 においても共用したい場合は、コードはどの様になりますか?
    あつかましいお願いなのですが、何とぞご教授宜しくお願い致します。
    以上
    • 編集済み sakuraxx 2014年5月30日 23:22 ブランク行を削除
    2014年5月29日 17:28
  • 同じ処理を行わせるならクラスに共通コードを置きます。

    Option Explicit
    'モジュールに作る
    Public Function CreateTextBoxEvent(ByVal uf As UserForm, ByVal name As String) As Collection
        Dim textBoxCollection As New Collection 'イベントを受け取るクラスを保存しておくためのコレクション
        Dim ctl As Control
        For Each ctl In uf.Controls
            If (Left(ctl.name, Len(name)) = name) Then 'TextBox○○という名前のコントロールを探す
                Dim txb As MSForms.textBox
                Set txb = ctl
                
                Dim sink As TextBoxChangedSink '下に記述してあるクラスモジュールの名前を参照する
                Set sink = New TextBoxChangedSink 'TextBoxのイベントを受け取るためのクラスを作る
                Call sink.Init(txb, uf) 'TextBoxとこのUserFormを登録する
    
                Dim key As String
                key = CInt(Mid(ctl.name, 8))
                Call textBoxCollection.Add(sink, key) 'イベントが消えないように保持する
            End If
        Next
        
        Set CreateTextBoxEvent = textBoxCollection
    End Function
    'クラスモジュールのコード
    '名前は適当でいいが、とりあえずオブジェクト名にTextBoxChangedSinkという名前を付ける
    Option Explicit
    
    Private WithEvents txb1 As MSForms.textBox 'イベントが発生するTextBox
    Private uf1 As UserForm
    
    'イベントが発生するTextBoxと発生したことを通知するUserFormを登録する
    Public Sub Init(ByVal txb As MSForms.textBox, ByVal uf As UserForm)
        Set txb1 = txb
        Set uf1 = uf
    End Sub
    
    'このクラスに登録されたTextBoxで発生した_KeyPressイベントを受け取る
    Private Sub txb1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        If (uf1 Is Nothing) Then
            Return
        End If
        
        If KeyAscii < Asc(0) Or KeyAscii > Asc(9) Then
            KeyAscii = 0
        End If
    End Sub

    として、各UserFormで以下のように使います。

    'UserForm1のコード
    Option Explicit
    Private textBoxCollection As Collection
    Private Sub UserForm_Initialize()
        Set textBoxCollection = CreateTextBoxEvent(Me, "TextBox")
    End Sub
    




    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    • 回答としてマーク sakuraxx 2014年5月30日 23:23
    2014年5月30日 3:58
  • gekkaさん、この度は大変お世話になっております。
    この度は貴重なサンプルコード提示いただき感謝いたします。
    コードも複雑になってきました。
    既に実践に応用できる程度の理解はできたと思っていますが、
    完全とは言えないので更に演習をと思っています。
    コピーペーにて試行環境は整ったのですが、標準モジュールに次のSUBを用意して、
    Sub UserForm1_Show()
        UserForm1.Show
    End Sub
    ボタン(フォームコントロール)にマクロの登録を行おうとしたのですが、
    次のメッセージが出ます…!?
    ⇒「数式が複雑すぎます。オブジェクトに登録する事はできません。」
    今回のケースは、ボタン等にマクロの登録はできないのでしょうか?
    ご教授宜しくお願い致します。
    以上

    2014年5月30日 8:30
  • ⇒「数式が複雑すぎます。オブジェクトに登録する事はできません。」
    今回のケースは、ボタン等にマクロの登録はできないのでしょうか?

    試した限りでは、マクロのあるEXCELファイルの名前やフォルダ名に半角の括弧[]があるとファイル名をうまく認識できないためにこのエラーが出るようです。

    たとえばC:\Test\A[.xlsとか。
    ファイルやフォルダ名に記号が混ざっているなら、一時的にフォルダを移動してみたり名前を変更してみてください。

    #もう一個の質問の方にご自身の返信のみを回答としていますが、役に立ちませんでした?


    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)


    • 編集済み gekkaMVP 2014年5月30日 15:08
    • 回答としてマーク sakuraxx 2014年5月30日 23:23
    2014年5月30日 15:07
  • gekkaさん、問題解決です…感謝
    ファイル名の[VBA]を取除いたら問題は解決しました。
    これで実践に活用できるかと思えば嬉しくてたまりません…本当に有難うございました。
    以上

    2014年5月30日 23:18