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 126 127 128 129 130 131 132 133 134 135 136 137 138
| Public Flag_RAZ As Boolean
Private Sub ComboBox1_Change()
Dim ligC, plage As Range, point
If Flag_RAZ = True Then Exit Sub
ComboBox2.Clear
Erase Table_ML, Table_Rang
With Worksheets("Fichier général")
derlig = .Range("A" & Rows.Count).End(xlUp).Row
Set plage = .Range("B1:B" & derlig)
Nb_Nom = Application.CountIf(plage, ComboBox1)
ReDim Table_ML(Nb_Nom)
ReDim Table_Rang(Nb_Nom)
point = 1
ligC = 1
If Nb_Nom > 0 Then
For x = 1 To Nb_Nom
ligC = .Columns("B").Find(ComboBox1, .Cells(ligC, "B"), , xlWhole).Row
'Numeros de Contrat
ComboBox2.AddItem .Cells(ligC, "A") & "--" & .Cells(ligC, "C")
'Calibres
Table_ML(point) = .Cells(ligC, "O")
'lignes
Table_Rang(point) = ligC
point = point + 1
Next x
Else
MsgBox ("Pas trouvé!!!!!!")
End If
End With
If ComboBox2.ListCount = 1 Then
ComboBox2.Value = ComboBox2.List(0)
End If
If Flag_RAZ = True Then Exit Sub
'ComboBox3.Clear
'ComboBox3.Value = Table_ML(ComboBox2.ListIndex + 1)
'ComboBox3.AddItem "M"
'ComboBox3.AddItem "L"
With Worksheets("Fichier général")
'C'est la que l'erreur apparait :oops:
TextBox1.Text = .Range("I" & Table_Rang(ComboBox2.ListIndex + 1)).Value
TextBox2.Text = .Range("J" & Table_Rang(ComboBox2.ListIndex + 1)).Value
End With
End Sub
Private Sub CommandButton1_Click()
Sheets("Saisie sstt").Activate
Unload Me
Sheets("Fichier général").Visible = xlVeryHidden
End Sub
Private Sub Userform_activate()
Dim derlig, plage As Range
Dim Dico_nom
Set Dico_nom = CreateObject("scripting.dictionary")
ComboBox1.Clear
With Worksheets("Fichier général")
'derniere cellule non vide colonne A
derlig = .Range("A" & Rows.Count).End(xlUp).Row
'mise en memoire plage nom
T_Trie = .Range("B2:B" & derlig).Value
End With
'tri aplha
n = UBound(T_Trie)
Call Sort(T_Trie)
Dico_nom.CompareMode = vbTextCompare
'boucle de remplissage combobox nom unique
For cel = 1 To n
If Not IsEmpty(T_Trie(cel, 1)) And Not Dico_nom.exists(T_Trie(cel, 1)) Then ' test des doublons
Dico_nom.Add T_Trie(cel, 1), ""
ComboBox1.AddItem T_Trie(cel, 1)
End If
Next cel
End Sub
Private Sub Valider_Click()
Flag_RAZ = True
With Worksheets("Fichier général")
.Range("I" & Table_Rang(ComboBox2.ListIndex + 1)).Value = TextBox1.Text
End With
ComboBox1 = ""
ComboBox2 = ""
'ComboBox3 = ""
TextBox1.Value = ""
Flag_RAZ = False
End Sub
Sub Sort(inpArray)
Dim intRet
Dim intCompare
Dim intLoopTimes
Dim strTemp
For intLoopTimes = 1 To UBound(inpArray)
For intCompare = LBound(inpArray) To UBound(inpArray) - 1
x = inpArray(intCompare, 1)
xx = inpArray(intCompare + 1, 1)
intRet = StrComp(inpArray(intCompare, 1), inpArray(intCompare + 1, 1), vbTextCompare)
If intRet = 1 Then
' String1 is greater than String2
strTemp = inpArray(intCompare, 1)
inpArray(intCompare, 1) = inpArray(intCompare + 1, 1)
inpArray(intCompare + 1, 1) = strTemp
End If
Next
Next
End Sub |
Partager