コピー貼り付けfrom userform

Question

私はユーザーフォームを作成しました。約19個のコンボボックスが含まれています。コンボボックスには、YESとNOという2つのオプションがあります。コメントが入力される各コンボボックスの前にテキストボックスが表示されます。私が望むのは、ユーザーがコンボボックスから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

私は私はあなたがテキストボックスのコメントをコピーする意味だと思う

ユーザーフォームからそのコンボボックスのコメントをコピー＆ペーストしたいですか？

これを処理する最善の方法は、コンボボックスの名前をComboBox1, ComboBox2..ComboBox19とすることです。同様にテキストボックスの場合は、TextBox1, textBox2... TextBox19と名前を付けます。 がComboBox1の前にあるようにしてください。

これを行う理由は、ループがより簡単になるためです。その中縦：互いに適切（推奨アプローチ）に対向texboxesやコンボボックスの名前を変更するための代替として

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

この例を参照してください、あなたはテキストボックス横軸（例えばかどうかをチェックすることにより、与えられたコンボボックスが直面しているテキストボックスを得ることができます）userfomレイアウトでそう、あなたの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