transférer les données d'une listbox dans la feuille de calcul excel

Version imprimable

1 pièce(s) jointe(s)

*Bonjour,*

j'ai réaliser un formulaire VBA pour la saisie des renseignement d'un patient avec sec examen demandées
sur UF j'ai introduit une listbox

Mon souci est comment peut-on Transférer les sélections sur la feuil lorsque en validant la saisie
voila le CODE:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private Sub CommandButton1_Click()
 
Dim i As Integer
If UserForm1.TextBox1 = "" Or UserForm1.TextBox2 = "" Then
    MsgBox "MERCI DE SIASIR Les Champs Nom et Prénom", vbCritical, "Champs manquants"
    TextBox1.SetFocus
    Else
 
 i = 1
 Do While Cells(i, 1) <> ""
 Cells(i, 1).Offset(1, 1).Select
 i = i + 1
 Loop
 ActiveCell.Value = UCase(UserForm1.TextBox1.Value)
 ActiveCell.Offset(0, 1).Value = UCase(Left(UserForm1.TextBox2.Value, 1)) & LCase(Right(UserForm1.TextBox2.Value, Len(UserForm1.TextBox2.Value) - 1))
 ActiveCell.Offset(0, 2).Value = UserForm1.TextBox3.Value
 ActiveCell.Offset(0, 4).Value = UserForm1.ComboBox1.Value
 UserForm1.TextBox1.Value = ""
 UserForm1.TextBox2.Value = ""
 UserForm1.TextBox3.Value = ""
 UserForm1.ComboBox1.Value = ""
 TextBox1.SetFocus
 
 End If
If ActiveCell.Offset(-1, -1).Value = "ID" Then
 ActiveCell.Offset(0, -1).Value = 1
 Else
 ActiveCell.Offset(0, -1).Value = ActiveCell.Offset(-1, -1).Value + 1
 
 End If
 
End Sub

sur la feuil les cellule reversées pour la sélection de la listbox est à partir de G2-N2

ci joint
Pièce jointe 203118

Si les items sont classés identiquement avec ceux de ta ligne

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Sub CommandButton1_Click()
Dim NewLig As Long
 
If Me.TextBox1 = "" Or Me.TextBox2 = "" Or Me.ListBox1.ListIndex = -1 Then
    MsgBox "MERCI DE SIASIR Les Champs Nom ou Prénom ou Examen", vbCritical, "Champs manquants"
    Me.TextBox1.SetFocus
Else
    With Worksheets("NomDeTaFeuille")
        NewLig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        With .Range("A" & NewLig)
            .Value = IIf(NewLig = 2, 1, .Offset(-1).Value + 1)
            .Offset(, 1).Value = UCase(Me.TextBox1.Value)
            .Offset(, 2).Value = StrConv(Me.TextBox2.Value, vbProperCase)
            .Offset(, 3).Value = Me.TextBox3.Value
            .Offset(, 5).Value = Me.ComboBox1.Value
        End With
        .Range("G" & NewLig).Offset(, Me.ListBox1.ListIndex).Value = "X"
    End With
 
    Me.TextBox1.Value = ""
    Me.TextBox2.Value = ""
    Me.TextBox3.Value = ""
    Me.ComboBox1.ListIndex = -1
    Me.ListBox1.ListIndex = -1
    Me.TextBox1.SetFocus
End If
End Sub

07/03/2016, 14h04
rabieho-lab

1 pièce(s) jointe(s)

merci mercatog pour la réponse rapide

j'ai recopier votre code et voila le résultat

Pièce jointe 203135 .
sur la ligne jaune en mettant la souris m'affiche NewLig = 2

je ne comprends pas le problème
07/03/2016, 15h24
mercatog

c'est à dire?
et quelle valeur doit on avoir?
08/03/2016, 10h19
rabieho-lab

1 pièce(s) jointe(s)

Bonjour mercatog

Effectivement c'est la ligne N° 2.

Mais le formulaire ne fait pas le Transfère des données sélectionner

Autre souci que au moment de faire le choix à plusieurs testes sur la listbox . le Transfère sa concerne que le teste après le dernier teste choisit et un seul teste qu'il se transfère (ce n'est pas l'ensemble des testes sélectionner) .

ci joint:
Pièce jointe 203231.

Quand on veut adapter, ça sera mieux de savoir ce qu'on fait

En plus, comment peut on deviner que pour ta listbox est à choix multiple

Pour cette fois, voila le code entier

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Private Sub CommandButton1_Click()
Dim NewLig As Long
Dim i As Integer
 
If Me.TextBox1 = "" Or Me.TextBox2 = "" Or Me.ListBox1.ListIndex = -1 Then
    MsgBox "MERCI DE SIASIR Les Champs Nom ou Prénom ou Examen", vbCritical, "Champs manquants"
    Me.TextBox1.SetFocus
Else
    With Worksheets("données")
        NewLig = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
        With .Range("A" & NewLig)
            .Value = IIf(NewLig = 2, 1, Val(.Offset(-1).Value) + 1)
            .Offset(0, 1).Value = UCase(Me.TextBox1.Value)
            .Offset(0, 2).Value = StrConv(Me.TextBox2.Value, vbProperCase)
            .Offset(0, 3).Value = Me.TextBox3.Value
            .Offset(0, 4).Value = Me.ComboBox1.Value
        End With
        For i = 0 To Me.ListBox1.ListCount - 1
            If Me.ListBox1.Selected(i) Then .Range("F" & NewLig).Offset(, i).Value = UCase(Me.ListBox1.List(i))
        Next i
    End With
 
    Me.TextBox1.Value = ""
    Me.TextBox2.Value = ""
    Me.TextBox3.Value = ""
    Me.ComboBox1.ListIndex = -1
    For i = 0 To Me.ListBox1.ListCount - 1
        Me.ListBox1.Selected(i) = False
    Next i
    Me.TextBox1.SetFocus
End If
End Sub

08/03/2016, 15h04
rabieho-lab

merci infiniment mercatog

c'est super.

merci également pour la pédagogie et la patience