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