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 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
|
Private Sub ComboBox1_Click()
Dim vrech As Range
ligne = ComboBox1.ListIndex + 2
Set vrech = Sheets("Feuil1").Cells(ligne, 1)
If Trim(vrech) = "" Then
MsgBox "Aucune valeur trouve!", , "Ref"
End If
TextBox7.Text = vrech.Offset(0, 1).Value
TextBox8.Text = vrech.Offset(0, 2).Value
TextBox1.Text = vrech.Offset(0, 3).Value
TextBox2.Text = vrech.Offset(0, 4).Value
Call Effacer_Reponses_Sur_Userform1
Call Lire_Les_Reponses_de_la_feuille
End Sub
Private Sub CommandButton4_Click()
Unload Me
End Sub
Private Sub CommandButton6_Click()
Dim cCont As Control
Dim question As String
Dim reponse As Double
ligne = ComboBox1.ListIndex + 2
Sheets("Feuil1").Cells(ligne, 1).Offset(, 1).Value = TextBox7.Text
Sheets("Feuil1").Cells(ligne, 1).Offset(, 2).Value = TextBox8.Text
Sheets("Feuil1").Cells(ligne, 1).Offset(, 3).Value = TextBox1.Text
Sheets("Feuil1").Cells(ligne, 1).Offset(, 4).FormulaLocal = TextBox2.Text 'La date
For Each cCont In Me.Controls
If TypeName(cCont) = "OptionButton" Then
question = cCont.Parent.Caption
reponse = cCont.Caption
Set col = Sheets("Feuil1").Range("A1:V1").Find(question, LookIn:=xlFormulas)
Sheets("Feuil1").Cells(ligne, col.Column) = "" 'Effacer la reponse
End If
Next cCont
For Each cCont In Me.Controls
If TypeName(cCont) = "OptionButton" Then
question = cCont.Parent.Caption
reponse = cCont.Caption
Set col = Sheets("Feuil1").Range("A1:V1").Find(question, LookIn:=xlFormulas)
If cCont.Value = True Then
Sheets("Feuil1").Cells(ligne, col.Column).FormulaLocal = reponse 'Ecrire ls reponse
End If
End If
Next cCont
End Sub
Private Sub UserForm_Activate()
Sheets("Feuil1").Select
ComboBox1.List = Range("A2:A" & Cells(Application.Rows.Count, 1).End(xlUp).Row).Value
End Sub
Private Sub Effacer_Reponses_Sur_Userform1()
Dim cCont As Control
For Each cCont In Me.Controls
If TypeName(cCont) = "OptionButton" Then
cCont.Value = False
End If
Next cCont
End Sub
Sub Lire_Les_Reponses_de_la_feuille()
Dim cCont As Control
Dim question As String
Dim reponse As Double
Dim ligne As Long
ligne = ComboBox1.ListIndex + 2
For Each cCont In Me.Controls
If TypeName(cCont) = "OptionButton" Then
question = cCont.Parent.Caption
reponse = cCont.Caption
Set col = Sheets("Feuil1").Range("A1:V1").Find(question, LookIn:=xlFormulas, lookat:=xlWhole)
If col Is Nothing Then
MsgBox "Colonne " & question & " non trouve!", , "Erreur"
Else
reponse = Sheets("Feuil1").Cells(ligne, col.Column)
If CStr(reponse) <> "" Then
If CDbl(reponse) = CDbl(cCont.Caption) Then
cCont.Value = True
End If
End If
End If
End If
Next cCont
End Sub |
Partager