userform boucle multiselct

Merci JB mais Je mets ce bout de code ou?


For i = 0 To Me.Choix.ListCount - 1
If Me.Choix.Selected(i) = True Then
.
End If
Next


> bonjour,
>
> voici le code de ma listbox
> Private Sub ListBox1_Click()
> Sheets("impress").Range("A1").Value = UserForm1.ListBox1.Value
> Unload UserForm1
> Run "Module2.copie"
> End Sub
>
> bon jusque là rien d 'extraodinaire..
>
> ensuite voici le code qui alimente mon userform
>
>
> Private Sub UserForm_Initialize()
> 'création tableau intermédiaire des clients
> Dim Table As Scripting.Dictionary
> Dim I&, j&, Valide As Boolean, A As Variant
> Dim nom, X, y
>
>
> Sheets("PARAM").Range("ts_client").Clear
>
> Set Table = New Scripting.Dictionary
> j = 0
> nom = "deb"
>
> boucle:
> If nom = "deb" Then
> nom = "2007"
> ElseIf nom = "2007" Then
> nom = "2008"
> Else: GoTo suite
> End If
>
>
> With Sheets(nom)
>
> 'colonne Q
> X = "Quoi"
> For Each A In .Range("P2:Q2" & .Range("A1").End(xlDown).Row)
> 'MsgBox A
> 'Vérifie si le nom n'est pas une erreur, n'est pas vide
> 'n'a pas déjà été récupéré, ou ne contient pas "clients"
> Valide = True
> If X = "Quoi" Then
> If UCase(A) = "NON" Then
> X = "NON"
> Else
> X = "OUI"
> End If
> Else
> If X = "NON" Then
> If IsError(A) Then
> Valide = False ' on n'y met pas les valeurs d'erreur
> ElseIf Len(A) = 0 Then
> Valide = False
> ElseIf Table.Exists(A.Value) Then
> Valide = False
> End If
> If Valide Then
> Table.Add A.Value, j: j = j + 1 'rajoute
> End If
> End If
> X = "Quoi"
> End If
>
> Next
>
> 'colonne S non contigues
>
> X = "Quoi"
> y = ""
>
> For Each A In .Range("P2:S2" & .Range("A1").End(xlDown).Row)
> 'MsgBox A
> 'Vérifie si le nom n'est pas une erreur, n'est pas vide
> 'n'a pas déjà été récupéré, ou ne contient pas "clients"
> Valide = True
> If X = "Quoi" Then
> If UCase(A) = "NON" Then
> X = "NON"
> Else
> X = "OUI"
> End If
> y = "DEUX"
> ElseIf y = "DEUX" Then
> y = "TROIS"
> ElseIf y = "TROIS" Then
> y = "QUATRE"
> ElseIf y = "QUATRE" Then
>
> If X = "NON" Then
> If IsError(A) Then
> Valide = False ' on n'y met pas les valeurs
> d'erreur
> ElseIf Len(A) = 0 Then
> Valide = False
> ElseIf Table.Exists(A.Value) Then
> Valide = False
> End If
> If Valide Then
> Table.Add A.Value, j: j = j + 1 'rajoute
> 'MsgBox ("ajout de " & j)
> End If
> End If
> X = "Quoi"
> End If
>
> Next
>
>
> End With
>
> GoTo boucle
>
> suite:
> For I = 0 To Table.Count - 1
> Debug.Print Table.Keys(I)
> 'ComboBox1.AddItem (Table.Keys(I))
> Sheets("PARAM").Cells(I + 1, 1) = Table.Keys(I)
> Next I
>
>
> Set Table = Nothing ' Nettoyage
>
> Sheets("PARAM").Activate
> Columns("A:A").Select
> Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
> Header:=xlGuess, _
> OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
> DataOption1:=xlSortNormal
>
> I = 1
> Do While Sheets("PARAM").Cells(I, 1) <> ""
> UserForm1.ComboBox1.AddItem (Sheets("PARAM").Cells(I, 1))
> I = I + 1
> Loop
> Sheets("impress").Activate
> 'UserForm1.Show
>
>
> End Sub
>
>
> ensuite voici mon module 2 qui récupère la valeur mise dans la cellule A1
> et effectue une procédure bien particulière
> Sub copie()
> For I = Range("c65536").End(xlUp).Row To 7 Step -1
> Cells(I, 1).EntireRow.Clear ' le 2 correspond au numero de colonne
> Next
>
>
> ligne = 2
> With Sheets("2007")
>
> For I = 1 To .[A65000].End(xlUp).Row
> 'MsgBox (.Cells(I, "Q"))
> If (.Cells(I, "Q") = Sheets("impress").Range("A1") Or .Cells(I,
> "S") = Sheets("impress").Range("A1")) And .Cells(I, "P") = "NON" Then
> .Rows(I).Copy Sheets("impress").Cells(ligne + 5, 1)
> ligne = ligne + 1
> End If
> Next
> End With
>
> With Sheets("2008")
> For I = 1 To .[A65000].End(xlUp).Row
> If (.Cells(I, "Q") = Sheets("impress").Range("A1") Or .Cells(I, "S") =
> Sheets("impress").Range("A1")) And .Cells(I, "P") = "NON" Then
> .Rows(I).Copy Sheets("impress").Cells(ligne + 5, 1)
> ligne = ligne + 1
> End If
> Next
>
> End With
>
> 'suppression colonnes + mise en forme
> Columns("D:L").Select
> Selection.Delete Shift:=xlToLeft
> Columns("B").Select
> Selection.Delete Shift:=xlToLeft
> 'Columns("k:s").Select
> 'Selection.Delete Shift:=xlToLeft
> Range("D4").Select
> ActiveCell.FormulaR1C1 = "=R[-3]C[-3]"
> Range("D4").Select
> With Selection.Font
> .Name = "Tahoma"
> .Size = 16
> .Strikethrough = False
> .Superscript = False
> .Subscript = False
> .OutlineFont = False
> .Shadow = False
> .Underline = xlUnderlineStyleNone
> .ColorIndex = xlAutomatic
> End With
> Range("A1").Select
> With Selection.Font
> .Name = "Arial"
> .FontStyle = "Normal"
> .Size = 8
> .Strikethrough = False
> .Superscript = False
> .Subscript = False
> .OutlineFont = False
> .Shadow = False
> .Underline = xlUnderlineStyleNone
> .ColorIndex = 2
> End With
>
>
> Range("A7").Select
>
>
> End Sub
>
>
>
>
>
> >
> MERCI D'AVANCE
>
> MAUD (et STEFANE)
>
> ps: j'espere avoir été claire
>
>
>