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
| Private Sub UserForm_Initialize()
Dim Cell As Range
Dim Unique As New Collection
Dim Valeur As Range
Dim IX As Integer
Set Flcd = ThisWorkbook.Worksheets("CC2012")
Set SDC = ThisWorkbook.Worksheets("Suivi de commande")
Set Fl = ThisWorkbook.Worksheets("facturation prévisionnelle")
Set rancom = Application.InputBox("Sélectionnez une plage !", "Sélection de cellules", Type:=8)
If Not rancom Is Nothing Then lNx = rancom.Row
Fl.Activate
' Remplissage de la feuille de facturation prévisionnelle.
Range("A1").Select
If Range("A2").Value <> "" Then ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
randes = ActiveCell.Row
ActiveCell.Offset(0, 1).Value = Flcd.Cells(lNx, 8) 'Nom du client
ActiveCell.Offset(0, 2).Value = rancom.Value 'Numéro de commande
ActiveCell.Offset(0, 3).Value = Flcd.Cells(lNx, 9) 'Nom du chantier
ActiveCell.Offset(0, 4).Value = Flcd.Cells(lNx, 5) 'statut(en cours/soldé)
ActiveCell.Offset(0, 5).Value = Date 'Date
Flcd.Cells(lNx, 1).Copy Fl.Cells(randes, 1) 'Numéro de Devis
Me.ListBox1.MultiSelect = fmMultiSelectMulti
For IX = 3 To SDC.Range("A" & SDC.Rows.Count).End(xlUp).Row
SDC.Activate
On Error Resume Next
'boucle sur les cellules de la colonne A
For Each Cell In SDC.Range("A3:A" & IX)
If SDC.Range(Cells(Cell.Row, 18)).Value = Flcd.Cells(lNx, 1) And _
SDC.Range(Cells(Cell.Row, 2)).Value = rancom.Value And _
SDC.Range(Cells(Cell.Row, 15)).Value = "" Then
'Stocke les données dans une collection
'(La collection n'accepte que des données uniques et permet donc de filtrer facilement les doublons).
Unique.Add Cell, CStr(Cell)
End If
Next Cell
Next
On Error GoTo 0
'Boucle sur le contenu de la collection pour alimenter la ListBox
For Each Valeur In Unique
Me.ListBox1.AddItem Valeur
Next Valeur
End Sub |
Partager