Question

我做了一个用户表单。它包含大约19个组合框。组合框有2个选项YES和NO。然后是每个组合框前面的文本框，输入注释。我想要的是，如果用户从组合框中选择“否”，我想复制将该组合框的注释从userform粘贴到另一个Excel工作表上。现在我复制粘贴所有评论。所以我也希望添加此功能。以下是我目前使用的代码。任何人都可以帮我升级这段代码，也可以添加上面提到的功能。

Private Sub ()
Dim ws As Worksheet
Set ws = Worksheets("PQCILDMS")

Dim newRow2 As Long

newRow2 = Application.WorksheetFunction.CountA(ws.Range("A:A")) + 1

ws.Cells(newRow2, 1).Value = cmbDMS.Value

Dim newRow3 As Long


newRow3 = Application.WorksheetFunction.CountA(ws.Range("A:A")) + 1

ws.Cells(newRow3, 1).Value = cmbYesNo.Value

Dim newRow4 As Long

newRow4 = Application.WorksheetFunction.CountA(ws.Range("A:A")) + 1

ws.Cells(newRow4, 1).Value = Me.txtComments.Value

ws.Cells(newRow4, 1).Columns.AutoFit


End Sub

Answer 1

我想从userform
复制粘贴组合框的评论

我认为你的意思是复制TextBox评论？

处理此问题的最佳方法是将您的ComboBoxes命名为ComboBox1, ComboBox2..ComboBox19。类似地，对于TextBox，将它们命名为TextBox1, textBox2... TextBox19。确保TextBox1位于ComboBox1前面，依此类推。

我们这样做的原因是循环变得更容易。见这个例子

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long

    '~~> Change this to the relevant sheet
    Set ws = Sheet1

    With ws
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1

        For i = 1 To 19
            If Me.Controls("ComboBox" & i).Value = "No" Then
                .Cells(lRow, 1).Value = Me.Controls("TextBox" & i).Value
                lRow = lRow + 1
            End If
        Next i
    End With
End Sub

Answer 2

作为适当重命名相互面对的texbox和组合框的替代方法（建议方法），您可以通过检查文本框水平轴（例如：它的中间纵坐标）来使文本框面向给定的组合框Userfom layout）穿过组合框

因此您可以将以下代码放入userfom代码窗格中：

Option Explicit

Dim Cbs As Collection '<--| set this collection as Userform scoped variable
Dim Tbs As Collection '<--| set this collection as Userform scoped variable


Private Sub CommandButton1_Click()
    Dim cb As MSForms.ComboBox, tb As MSForms.TextBox
    Dim el As Variant

    With Worksheets("PQCILDMS") '<--| reference sheet
        For Each el In Cbs '<--|loop through all userform comboboxes
            Set cb = el '<--|set the current combobox control
            If cb.value = "NO" Then '<--|if its value is "NO" ...
                Set tb = GetTbNextToCb(cb, Tbs) '<--|... look for the textbox whose horizontal axis is inbetween the current combobox
                If Not tb Is Nothing Then .Cells(.Rows.Count, 1).End(xlUp).Offset(1).value = tb.value '<--|... if found it then write its content in referenced sheet column "A" next available cell
            End If
        Next el
    End With
End Sub


Function GetTbNextToCb(cb As MSForms.ComboBox, Tbs As Collection) As MSForms.TextBox
    Dim tb As MSForms.TextBox
    Dim cbYMin As Long, cbYMax As Long, tbYMin As Long, tbYMax As Long
    Dim el As Variant

    GetYMinMax cb, cbYMin, cbYMax '<--| get minimum and maximum ordinate of passed combobox

    For Each el In Tbs '<--|loop through all userform textboxes
        Set tb = el '<--|set the current textbox control
        If IsAxisInBetween(tb, cbYMin, cbYMax) Then '<--|if current textbox horizontal axis inbetween passed combobox minimum and maximum ordinates...
            Set GetTbNextToCb = tb '...return the found textbox...
            Exit Function '<--|... and exit function (no need to iterate over remaining textboxes)
        End If
    Next el
End Function

Function IsAxisInBetween(ctrl As Control, yMinRef As Long, yMaxRef As Long) As Boolean
    Dim yMin As Long, yMax As Long

    GetYMinMax ctrl, yMin, yMax '<--| get minimum and maximum ordinates of the control in the userform
    IsAxisInBetween = (yMax + yMin) / 2 <= yMaxRef And (yMax + yMin) / 2 >= yMinRef '<--| check if the control orizontal axis is in between the reference ordinates
End Function

Sub GetYMinMax(ctrl As Control, yMin As Long, yMax As Long)
    With ctrl
        yMin = .Top '<--| get the minimum ordinate of the control in the Userform
        yMax = .Top + .Height '<--| get the maximum ordinate of the control in the Userform
    End With
End Sub



'this sub will run at Userfom loading
Private Sub UserForm_Initialize()
    Set Cbs = GetCtrls("ComboBox") '<--| gather all Userform comboboxes in this collection
    Set Tbs = GetCtrls("TextBox") '<--| gather all Userform texboxes in this collection
End Sub

Function GetCtrls(ctrlTypeName As String) As Collection
    Dim coll As New Collection '<--| declare and set a new Collection object
    Dim ctrl As Control

    For Each ctrl In Me.Controls '<--| loop through all Userform controls
        If TypeName(ctrl) = ctrlTypeName Then '<--| if it matches the passed Type name...
            coll.Add ctrl, ctrl.Name '<--| ... then add it to the collection
        End If
    Next ctrl
    Set GetCtrls = coll '<--| return the collection
End Function

从userform复制粘贴

2 个答案: