Question

如何使用WithEvents处理程序通过动态创建的滚动条更新动态创建的文本框？我在下面有这个用户格式代码，之后有类模块。

Option Explicit

Dim TextArray() As New Class1
Dim ScrollArray() As New Class1


Private Sub UserForm_Initialize()
    Dim ctlScroll As MSForms.ScrollBar
    Dim ctlText As MSForms.TextBox

    Dim ScrollTop As Long, i As Long

    '~~> Decide on the .Top for the 1st TextBox
    ScrollTop = 10



    For i = 1 To 10
        Set ctlScroll = Me.Controls.Add("forms.ScrollBar.1", "ScrollBar" & i)
        With ctlScroll
            .Left = 100
            .Top = ScrollTop
            .Width = 65
            .Height = 18
            .Orientation = fmOrientationHorizontal
            .Min = 1
            .Max = 5
        End With

        Set ctlText = Me.Controls.Add("forms.TextBox.1", "TextBox" & i)
        With ctlText
            .Left = 40
            .Top = ScrollTop
            .Width = 50
            .Height = 18
            .MultiLine = False
            .MaxLength = 3
        End With

        ScrollTop = ScrollTop + 20
        ReDim Preserve ScrollArray(1 To i)
        Set ScrollArray(i).ScrollEvents = ctlScroll
        ReDim Preserve TextArray(1 To i)
        Set TextArray(i).TextEvents = ctlText

    Next i


End Sub

这是事件处理程序的类模块

Public WithEvents ScrollEvents As MSForms.ScrollBar
Public WithEvents TextEvents As MSForms.TextBox


Private Sub ScrollEvents_Scroll()
    TextEvents.Value = ScrollEvents.Value
End Sub

Answer 1

能够解决它。

Option Explicit

Dim mColEvents As New Collection
Dim ScrlEventsArray() As New Class1


Private Sub UserForm_Initialize()
    Dim ctlctl As MSForms.Control


    Dim ScrollTop As Long, i As Long

    '~~> Decide on the .Top for the 1st TextBox
    ScrollTop = 10


    Set mColEvents = New Collection

    For i = 1 To 10

        Set ctlctl = Me.Controls.Add("forms.ScrollBar.1", "ScrollBar" & i)
        With ctlctl
            .Left = 100
            .Top = ScrollTop
            .Width = 65
            .Height = 18
            .Orientation = fmOrientationHorizontal
            .Min = 1
            .Max = 5
        End With

        ReDim Preserve ScrlEventsArray(1 To i)
        Set ScrlEventsArray(i) = New Class1
        Set ScrlEventsArray(i).ScrollEvents = ctlctl

        Set ctlctl = Me.Controls.Add("forms.TextBox.1", "TextBox" & i)
        With ctlctl
            .Left = 40
            .Top = ScrollTop
            .Width = 50
            .Height = 18
            .MultiLine = False
            .MaxLength = 3
            .Text = "1"
            .Value = 1
        End With

        Set ScrlEventsArray(i).TextB = ctlctl

        'mColEvents(i).Add TextArray(i)
        ScrollTop = ScrollTop + 20
    Next i


End Sub

课程模块。

Public WithEvents ScrollEvents As MSForms.ScrollBar
Public TextB As MSForms.TextBox


Private Sub ScrollEvents_Scroll()
TextB.Value = ScrollEvents.Value
End Sub

VBA宏动态创建Scrollbar更新动态创建的Textbox

1 个答案: