根据行数自动创建文本框

Question

VBA Excel 用户表单中有没有一种方法可以根据特定工作表上的行数在用户表单上自动创建文本框？

我的数据在表格 1 中，从 A1 开始，即：

• A1：发票日期
• B1：发票号
• C1：发票金额
• D1：已收到付款

现在有很多行数据（发票），我们无法知道有多少行与特定客户相关。当用户表单加载时，收到的付款文本框将为空，而发票日期、发票编号和发票金额将从工作表 1 中获取。

然后很容易填写收到的付款文本框，付款可以应用于特定发票。

Answer 1

如果您有这样的电子表格：

您可以向“显示表单”按钮添加点击处理程序：

Sub FormButton_Click()
    TestForm.Show
End Sub

在 TestForm 代码中：

Option Explicit

Const dateCol = 1
Const invoiceNumCol = 2
Const amountCol = 3
Const paymentCol = 4

Private Sub SaveButton_Click()
    Dim row As Range
    Dim box As Control

    For Each row In ActiveSheet.Rows
        On Error GoTo ExitHandler
        row.Cells(1, paymentCol).value = Me.Controls(row.row & paymentCol).value
    Next row

ExitHandler:
    Exit Sub
End Sub

Private Sub UserForm_Initialize()
    Dim row As Range

    For Each row In ActiveSheet.Rows
        If row.Cells(1, dateCol).value = "" Then
            Exit For
        End If

        Call AddBox(row, dateCol)
        Call AddBox(row, invoiceNumCol)
        Call AddBox(row, amountCol)
        Call AddBox(row, paymentCol)
    Next row
End Sub

Private Sub AddBox(row, colIndex)
    Dim box As Control

    Const width = 50
    Const padWidth = width + 4
    Const height = 15
    Const padHeight = height + 4
    Const topMargin = 25
    Const leftMargin = 5

    Set box = Me.Controls.Add("Forms.TextBox.1", row.row & colIndex)
    box.Left = (colIndex - 1) * padWidth + leftMargin
    box.height = height
    box.width = width
    box.Top = (row.row - 1) * padHeight + topMargin
    box.value = row.Cells(1, colIndex).value
End Sub

表单将如下所示：

值可以输入到付费列，当点击保存按钮时，它们将被复制到电子表格中。

为了解释逻辑，它遍历每个填充的行，创建适当的控件并填充值。在 Save 例程中，再次循环遍历行，并将付款值复制回电子表格。

Answer 2

假设一个名为“frmMain”的表单，然后添加4个文本框，下面的子程序应该这样做：

Private Sub AddTextBoxes()

Dim ctlTextBox As MSForms.TextBox
Dim intCol, intCols As Integer
Dim strCName As String

' Determine number of columns
intCols = 1
Do While Worksheets("Sheet1").Cells(1, intCols).Value <> ""
    intCols = intCols + 1
Loop

' Add text boxes
For intCol = 1 To intCols - 1
    strCName = "txtC" & intCol
    Set ctlTextBox = frmMain.Controls.Add("Forms.Textbox.1", strCName)

    With ctlTextBox
        .Top = 10
        .Width = 50
        .Height = 20
        .Left = (intCol) * 60
        .Value = intCol
    End With

Next

' Assuming there is a column 1 (i.e. "Invoice Data") the control name will be "txtC1"
' This box can be set by:

frmMain.Controls("txtC1").Value = 999



End Sub

Answer 3

除上述之外，向 frmMain 添加一个名为“fmeMain”的框架，并为 fmeMain 设置以下属性：

ScrollBars = 2 - fmScrollBarsVertical 滚动高度 = 800

向 frmMain 添加一个名为“cmdTest”的命令按钮。在 frmMain 的代码模块中添加以下子程序：

Private Sub AddTextBoxes()

Dim ctlTextBox As MSForms.TextBox
Dim intCol, intRow, intTop As Integer
Dim strCName As String

intTop = 10

For intRow = 2 To 31        ' Assumes that row 1 contains header

    For intCol = 1 To 3

        strCName = "txtC" & intCol & "R" & intRow
        Set ctlTextBox = frmMain.Controls("fmeMain").Add("Forms.Textbox.1", strCName)

        With ctlTextBox
            .Top = intTop
            .Width = 50
            .Height = 20
            .Left = 52 * intCol
            .Value = Worksheets("Sheet1").Cells(intRow, intCol).Value
        End With


    Next

    intTop = intTop + 25

Next


End Sub



Private Sub cmdTest_Click()

AddTextBoxes

End Sub