【VBA】フォームにControlを動的に配置してクラスでイベントを受け取る

0

    <機能>

    ・フォームにControlをオーナードローします

     TextBox×20

     OptionButton×60(3個1組でグループ化)

     ConboBox×20

     Label×20

    ・フォームのプロパティをスクロールできるよう設定します

     ScrollBars(スクロールバーの表示)

     ScrollHeight(フォーム全体の高さ)

    ・クラス(WithEvents)でイベントを受け取ります

     Class1:OptionButtonクリックイベントのコールバック

     Class2:ComboBox選択変更イベントのコールバック

     

    <動作環境>

    Microsoft Office 2016

     

    <実行イメージ>

    フォームInitializeでコントロールを配置

    (テキスト、ラジオ、コンボ、ラベルを20組配置)

    VBA,Class,WithEvents,Controls,OptionButton,TextBox,ComboBox,グループ化,
    イベントを受け取りテキストボックスに結果表示します

    VBA,Class,WithEvents,Controls,OptionButton,TextBox,ComboBox,
     

    <使い方>

    フォームを追加します(ID:UserForm1)


     

    ラジオボタンイベント通知クラスを追加します(Class1)

    コンボボックスイベント通知クラスを追加します(Class2)

    フォーム表示用の標準モジュールを追加します(Module1)


    ソースを貼り付けます

    ユーザフォーム表示()を実行するとフォームを表示します

     

    Module1

    '/*********************************************

    '/ ユーザフォームを表示する
    '/*********************************************

    Public Sub ユーザフォーム表示()
        UserForm1.Show
    End Sub
     

    UserForm1

    '//フォームの幅
    Private Const D_FWIDTH = 400
    '//フォームの高さ
    Private Const D_FHEIGHT = 500
    '//配置するテキストボックスの幅
    Private Const D_WIDTH = 230
    '//配置するテキストボックスの高さ
    Private Const D_HEIGHT = 100
    '//配置するテキストボックスの間隔
    Private Const D_MARGIN = 10
    '//配置するコントロールグループの数
    Private Const D_CONTROLCNT = 20
    '//イベントを検知するクラス(OptionButton)
    Private cls1(1 To D_CONTROLCNT * 3) As New Class1
    '//イベントを検知するクラス(ComboBox)
    Private cls2(1 To D_CONTROLCNT) As New Class2

     

    '/*********************************************
    '/ フォームの初期化イベント
    '/ 動的にコントロールを配置する
    '/ ※コントロールの種類は
    DeveloperNetwork参照
    '/  テキストボックス
    '/  ラジオボタン(OptionButton)×3(グループ化)
    '/  コンボボックス
    '/  ラベル
    '/*********************************************

    Private Sub UserForm_Initialize()

     

        '//フォームのスクロール(垂直方向)有効
        UserForm1.ScrollBars = fmScrollBarsVertical
        '//フォームのスクロールを含めた高さ
        UserForm1.ScrollHeight = 20 + D_CONTROLCNT * (D_HEIGHT + D_MARGIN)
        '//コントロールを格納する
        Dim tmpOB As Control
        Dim tmpCB As Control
       
        For i = 1 To D_CONTROLCNT
            '//テキストボックスを追加
            With UserForm1.Controls.Add("Forms.TextBox.1")
                .Top = 20 + (i - 1) * (D_HEIGHT + D_MARGIN)
                .Left = 40
                .Width = D_WIDTH
                .Height = D_HEIGHT
                .MultiLine = True
            End With
           
            '//ラジオボタンを追加
            Set tmpOB = UserForm1.Controls.Add("Forms.OptionButton.1")
            With tmpOB
                .Top = 20 + (i - 1) * (D_HEIGHT + D_MARGIN)
                .Left = D_WIDTH + 60
                .Width = 80
                .Height = 20
                .Caption = "ラジオボタン" & CStr(((i - 1) * 3) + 1)
                .GroupName = "OB" & CStr(i) '//グループ化する
                .Value = True
            End With
            cls1(((i - 1) * 3) + 1).initClass tmpOB, ((i - 1) * 3) + 1
           
            Set tmpOB = UserForm1.Controls.Add("Forms.OptionButton.1")
            With tmpOB
                .Top = 40 + (i - 1) * (D_HEIGHT + D_MARGIN)
                .Left = D_WIDTH + 60
                .Width = 80
                .Height = 20
                .Caption = "ラジオボタン" & CStr(((i - 1) * 3) + 2)
                .GroupName = "OB" & CStr(i) '//グループ化する
                .Value = False
            End With
            cls1(((i - 1) * 3) + 2).initClass tmpOB, ((i - 1) * 3) + 2
           
            Set tmpOB = UserForm1.Controls.Add("Forms.OptionButton.1")
            With tmpOB
                .Top = 60 + (i - 1) * (D_HEIGHT + D_MARGIN)
                .Left = D_WIDTH + 60
                .Width = 80
                .Height = 20
                .Caption = "ラジオボタン" & CStr(((i - 1) * 3) + 3)
                .GroupName = "OB" & CStr(i) '//グループ化する
                .Value = False
            End With
            cls1(((i - 1) * 3) + 3).initClass tmpOB, ((i - 1) * 3) + 3
           
            '//コンボボックスを追加
            Set tmpCB = UserForm1.Controls.Add("Forms.ComboBox.1")
            With tmpCB
                .Top = 80 + (i - 1) * (D_HEIGHT + D_MARGIN)
                .Left = D_WIDTH + 60
                .Width = 80
                .Height = 20
                .List = Array("晴れ", "曇り", "雨")
                .ListIndex = 0
            End With
            cls2(i).initClass tmpCB, i
           
            '//ラベルを追加
            With UserForm1.Controls.Add("Forms.Label.1")
                .Top = 20 + (i - 1) * (D_HEIGHT + D_MARGIN)
                .Left = 5
                .Width = 30
                .Height = 20
                .Caption = "No." + CStr(i)
            End With
        Next
    End Sub

     

    Class1(OptionButton通知)

    '//イベントを受け取るコントロール

    Private WithEvents OB As MSForms.OptionButton
    '//コントロールのインデックスを格納
    Private idx As Integer
     
    '/*********************************************
    '/ ラジオボタン(OptionButton)をセット
    '/*********************************************

    Public Sub initClass(ByVal o As MSForms.OptionButton, ByVal i As Integer)
        Set OB = o
        idx = i
    End Sub
     
    '/*********************************************
    '/ ラジオボタン(OptionButton)クリックイベント
    '/*********************************************

    Private Sub OB_Click()
        Dim strControl As String
        Dim tmpText As Control
        Dim strText As String
       
        '//ユーザフォームのテキストボックスに出力
        strControl = OB.Name
        '//OptionButton1(idx=1)→TextBox1に出力
        '//OptionButton2(idx=2)→TextBox1に出力
        '//OptionButton3(idx=3)→TextBox1に出力
        '//OptionButtonN(idx=N)→TextBox{(idx-1)÷3の商+1}に出力

        Set tmpText = UserForm1.Controls("TextBox" & CStr(((idx - 1) ¥ 3) + 1))
        If tmpText.Value = "" Then
            strText = ""
        Else
            strText = tmpText.Value & vbCrLf
        End If
        strText = strText & "ラジオがクリックされました name=" & strControl
       
        tmpText.Value = strText
    End Sub
     
    Class2(ComboBox通知)
    '//イベントを受け取るコントロール
    Private WithEvents CB As MSForms.ComboBox
    '//コントロールのインデックスを格納
    Private idx As Integer
     
    '/*********************************************
    '/ コンボボックス(ComboBox)をセット
    '/*********************************************

    Public Sub initClass(ByVal c As MSForms.ComboBox, ByVal i As Integer)
        Set CB = c
        idx = i
    End Sub
     
    '/*********************************************
    '/ コンボボックス(ComboBox)選択偏向イベント
    '/*********************************************

    Private Sub CB_Change()
        Dim strControl As String
        Dim tmpText As Control
        Dim strText As String
       
        '//ユーザフォームのテキストボックスに出力
        strControl = CB.Name
        Set tmpText = UserForm1.Controls("TextBox" & CStr(idx))
        If tmpText.Value = "" Then
            strText = ""
        Else
            strText = tmpText.Value & vbCrLf
        End If
        strText = strText & "コンボが " & CB.Value & " に変更されました name=" & strControl
       
        tmpText.Value = strText
    End Sub
     
    よろしければポチッと押してください

     



    calendar

    S M T W T F S
    1234567
    891011121314
    15161718192021
    22232425262728
    293031    
    << July 2018 >>

    profile

    others

    mobile

    qrcode         スマホ表示に戻す