Когда конкретный элемент выбран в списке на пользовательской форме, текст в другом текстовом поле должен быть скопирован в ячейку таблицы - PullRequest
0 голосов
/ 16 января 2019

Я создал пользовательскую форму со списками и текстовыми полями. Список содержит несколько элементов, но когда конкретный элемент «Autre» выбран в одном из списков, я хочу, чтобы элементы, выбранные в списке, а также текст в соответствующем текстовом поле (которое является описанием «Autre») были скопированы в стол.

Вот как выглядит мой код:

Private Sub cmdSauvegarder_Click()

Dim rng As Range
Set rng = ActiveSheet.ListObjects("Tableau1").Range
Dim LastRow As Long
LastRow = rng.Find(What:="*", _
After:=rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row

        rng.Parent.Cells(LastRow + 1, 1).Value = Me.txtDate.Value
        rng.Parent.Cells(LastRow + 1, 2).Value = Me.txtNom.Value
        rng.Parent.Cells(LastRow + 1, 3).Value = Me.txtPrenom.Value
        rng.Parent.Cells(LastRow + 1, 4).Value = Me.cboAge.Value
        rng.Parent.Cells(LastRow + 1, 5).Value = Me.cboGenre.Value
        rng.Parent.Cells(LastRow + 1, 6).Value = Me.txtNationalite.Value
        rng.Parent.Cells(LastRow + 1, 7).Value = Me.txtAdresse.Value
        rng.Parent.Cells(LastRow + 1, 8).Value = Me.txtTelephone.Value
        rng.Parent.Cells(LastRow + 1, 9).Value = Me.cboQuartier.Value
        rng.Parent.Cells(LastRow + 1, 10).Value = Me.cboProfessionnel.Value
        If rng.Parent.Cells(LastRow + 1, 10).Value = "Autre" Then rng.Parent.Cells(LastRow + 1, 10).Value = "Autre: " & Me.txtProfessionnel.Value
        rng.Parent.Cells(LastRow + 1, 11).Value = Me.cboMarital.Value
        If rng.Parent.Cells(LastRow + 1, 11).Value = "Autre" Then rng.Parent.Cells(LastRow + 1, 11).Value = "Autre: " & Me.txtMarital.Value

        myVar = ""
        For x = 0 To Me.listDejavenu.ListCount - 1
            If Me.listDejavenu.Selected(x) Then
                If myVar = "" Then
                    myVar = Me.listDejavenu.List(x, 0)
                Else
                    myVar = myVar & ", " & Me.listDejavenu.List(x, 0)
                End If
            End If
            If rng.Parent.Cells(LastRow + 1, 12).Value = "Autre" Then rng.Parent.Cells(LastRow + 1, 12).Value = Me.listDejavenu.Value & ": " & Me.txtDejavenu.Value Else: rng.Parent.Cells(LastRow + 1, 12).Value = myVar

            Next

        myWar = ""
        For y = 0 To Me.ListBesoinExprime.ListCount - 1
            If Me.ListBesoinExprime.Selected(y) Then
                If myWar = "" Then
                      myWar = Me.ListBesoinExprime.List(y, 0)
                Else
                    myWar = myWar & ", " & Me.ListBesoinExprime.List(y, 0)
                End If
            End If
            If rng.Parent.Cells(LastRow + 1, 13).Value = "Autre" Then rng.Parent.Cells(LastRow + 1, 13).Value = Me.ListBesoinExprime.Value & ": " & Me.txtBesoinExprime.Value Else: rng.Parent.Cells(LastRow + 1, 13).Value = myWar

        Next

      myTar = ""
        For Z = 0 To Me.ListDejaSuivi.ListCount - 1
            If Me.ListDejaSuivi.Selected(Z) Then
                If myTar = "" Then
                      myTar = Me.ListDejaSuivi.List(Z, 0)
                Else
                    myTar = myTar & ", " & Me.ListDejaSuivi.List(Z, 0)
                End If
            End If
            If rng.Parent.Cells(LastRow + 1, 14).Value = "Autre" Then rng.Parent.Cells(LastRow + 1, 14).Value = Me.ListDejaSuivi.Value & ": " & Me.txtDejaSuivi.Value Else: rng.Parent.Cells(LastRow + 1, 14).Value = myTar

        Next

     myPar = ""
        For v = 0 To Me.ListRedirigeVers.ListCount - 1
            If Me.ListRedirigeVers.Selected(v) Then
                If myPar = "" Then
                      myPar = Me.ListRedirigeVers.List(v, 0)
                Else
                    myPar = myPar & ", " & Me.ListRedirigeVers.List(v, 0)
                End If
            End If
            If rng.Parent.Cells(LastRow + 1, 15).Value = "Autre" Then rng.Parent.Cells(LastRow + 1, 15).Value = Me.ListRedirigeVers.Value & ": " & Me.txtRedirigevers.Value Else: rng.Parent.Cells(LastRow + 1, 15).Value = myPar

        Next


Call resetform

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...