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:=False, 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
>
>
>
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
maud s
Bonjour Personne ne veut m'aider???.... snif.....snif....
"maud s" a écrit dans le message de news: %
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
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
Bonjour
Personne ne veut m'aider???.... snif.....snif....
"maud s" <maud2604@neuf.fr> a écrit dans le message de news:
%23HCWKOkdIHA.5208@TK2MSFTNGP04.phx.gbl...
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
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
Bonjour Personne ne veut m'aider???.... snif.....snif....
"maud s" a écrit dans le message de news: %
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
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