Kopie einfügen von Benutzerformular

Question

Ich habe ein Benutzerformular erstellt. Es enthält ungefähr 19 Kombinationsfelder. Kombinationsfelder haben 2 Optionen YES und NO. Dann erscheint ein Textfeld vor jedem Kombinationsfeld, in dem Kommentare eingegeben werden. Was ich will, ist, dass, wenn Benutzer Nein aus dem Kombinationsfeld, das ich kopieren möchte, kopieren Sie die Kommentare dieses Kombinationsfeld aus Benutzerformular auf ein anderes Excel-Blatt einfügen möchten. Gerade jetzt kopiere ich alle Kommentare. Also ich möchte diese Funktion auch hinzufügen. Unten ist der Code, den ich gerade verwende. Kann mir jemand helfen, diesen Code zu aktualisieren, um das oben erwähnte Feature hinzuzufügen.

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

ich die Kommentare dieses Kombinationsfeld von Userform

Ich denke, fügen Sie kopieren möchte meinen Sie TextBox Kommentare kopieren?

Der beste Weg, dies zu handhaben, ist, benennen Sie Ihre ComboBoxen als ComboBox1, ComboBox2..ComboBox19. Weisen Sie für die TextBoxen dieselben Namen wie TextBox1, textBox2... TextBox19. Stellen Sie sicher, dass TextBox1 vor ComboBox1 und so weiter ist.

Der Grund dafür ist, dass es einfacher zu loopen ist. Sehen Sie dieses Beispiel

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

als Alternative zu den in geeigneter Weise texboxes und Comboboxen Umbenennung einander (vorgeschlagene Konzept) zugewandten Seite, können Sie die Textbox bekommen konnte eine gegebene Combobox mit Blick durch Prüfen, ob Textbox horizontale Achse (zB: ihre mittlere Ordinate im Userfom Layout) der Combobox

so überquert man den folgenden Code in Ihre userfom Codebereich setzen könnte:

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