userform boucle multiselct

Le
maud s
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
>
>
>
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
maud s
Le #5239751
Bonjour
Personne ne veut m'aider???.... snif.....snif....



"maud s" %
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













Publicité
Poster une réponse
Anonyme