USERFORM MULTISELECT BOUCLE

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 "clie nts"
    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 "clie nts"
    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:=False, Orientation:=xlTop ToBottom, _
        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 .C ells(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

MAINTENANT MON PROBLEME ET C'EST LA QUE JE PECHE UN PEU

j'aimerais que dans ma zone de listbox je puisse sélectionner plusieurs
ligne (ca je sais faire listbox multiselect)

mon soucis c'est: comment lui indiquer d'executer la macro (la boucle) ave c,
non plus la donnée choisie en A1 mais de A1:Ai suivant le nombre d'occur ence
choisi dans ma listbox....

désolé je ne peux pas  mettre mon fichier sur le net car en fait ce fichier
contient des noms de clients.....

MERCI D'AVANCE

MAUD (et STEFANE)

ps: j'espere avoir été claire

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

MAINTENANT MON PROBLEME ET C'EST LA QUE JE PECHE UN PEU

j'aimerais que dans ma zone de listbox je puisse sélectionner plusieurs
ligne (ca je sais faire listbox multiselect)

mon soucis c'est: comment lui indiquer d'executer la macro (la boucle)
avec,
non plus la donnée choisie en A1 mais de A1:Ai suivant le nombre
d'occurence
choisi dans ma listbox....

désolé je ne peux pas mettre mon fichier sur le net car en fait ce fichier
contient des noms de clients.....

MERCI D'AVANCE

MAUD (et STEFANE)

ps: j'espere avoir été claire

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





MAINTENANT MON PROBLEME ET C'EST LA QUE JE PECHE UN PEU

j'aimerais que dans ma zone de listbox je puisse sélectionner plusieurs
ligne (ca je sais faire listbox multiselect)

mon soucis c'est: comment lui indiquer d'executer la macro (la boucle)
avec, non plus la donnée choisie en A1 mais de A1:Ai suivant le nombre
d'occurence choisi dans ma listbox....

désolé je ne peux pas mettre mon fichier sur le net car en fait ce
fichier contient des noms de clients.....

MERCI D'AVANCE

MAUD (et STEFANE)

ps: j'espere avoir été claire