Discussion :

[Mr l'Ashanti]

bonsoir à vous.
je voudrais afficher dans ma listbox le choix fait dans le combobox. dans la base de donnée le filtre se fait aisement apres selection du critère mais je n'arrive pas à le transposer dans ma listbox. voir code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
If T_fitre2.Text = "CP1" Then
 ActiveSheet.ListObjects("Tab_1").Range.AutoFilter Field:=4, Criteria1:= _
        "CP1"
ElseIf T_fitre2.Text = "CP2" Then
ActiveSheet.ListObjects("Tab_1").Range.AutoFilter Field:=4, Criteria1:= _
        "CP2"
        ElseIf T_fitre2.Text = "CE1" Then
ActiveSheet.ListObjects("Tab_1").Range.AutoFilter Field:=4, Criteria1:= _
        "CE1"
        ElseIf T_fitre2.Text = "CE2" Then
ActiveSheet.ListObjects("Tab_1").Range.AutoFilter Field:=4, Criteria1:= _
        "CE2"
        ElseIf T_fitre2.Text = "CM1" Then
ActiveSheet.ListObjects("Tab_1").Range.AutoFilter Field:=4, Criteria1:= _
        "CM1"
        ElseIf T_fitre2.Text = "CM2" Then
ActiveSheet.ListObjects("Tab_1").Range.AutoFilter Field:=4, Criteria1:= _
        "CM2"
 
End If

et j'alimente ma listbox avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Dim f
Set f = Sheets("source")
Me.ListBox3.ColumnCount = f.Columns.Count
Me.ListBox3.BoundColumn = f.Columns.Count
Me.ListBox3.List = Range(f.[A1], f.[Z6500].End(xlUp)).Value
Me.ListBox3.Multiselect = fmMultiSelectMulti
ListBox3.ColumnWidths = "80;150;100;100;100;100;100;100;100;100;100;100;100;100;100;100;100;100;80;100;150;100;150;100;85;85;85;100"

quel code puis je ajouter au premier pour que le tableau qui est trié s'affiche dans la listbox .merci

[boisgontierjacques]

Bonour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Compare Text
Dim TBlBD()
Private Sub UserForm_Initialize()
  TBlBD = [tableau1].Value        ' pour rapidité
  Me.ListBox1.List = TBlBD
  Me.ListBox1.ColumnCount = [tableau1].Columns.Count
  Me.ListBox1.ColumnWidths = "30;50;50;50;50;50;50;50;50;50;50"
  '--- ComboBox
  Set d = CreateObject("scripting.dictionary")
  d("*") = ""
  For i = 1 To UBound(TBlBD)
    d(TBlBD(i, 4)) = ""
  Next i
  temp = d.keys
  Me.ComboBox1.List = temp
End Sub
 
Private Sub ComboBox1_click()
  ColRecherche = 4
  clé = Me.ComboBox1: n = 0
  Dim Tbl()
  For i = 1 To UBound(TBlBD)
    If TBlBD(i, ColRecherche) Like clé Then
        n = n + 1: ReDim Preserve Tbl(1 To UBound(TBlBD, 2), 1 To n)
        For k = 1 To UBound(TBlBD, 2): Tbl(k, n) = TBlBD(i, k): Next k
     End If
  Next i
  If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.Clear
End Sub

Boisgontier

[boisgontierjacques]

Version avec choix classe par combobox & recherche intuitive sur le nom

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Dim TBlBD(), Tbl()
Private Sub UserForm_Initialize()
  TBlBD = [tableau1].Value        ' pour rapidité
  Me.ListBox1.List = TBlBD
  Me.ListBox1.ColumnCount = [tableau1].Columns.Count
  Me.ListBox1.ColumnWidths = "30;50;50;50;50;50;50;50;50;50;50"
  '------------------------ Alimentation ComboBox
  Set d = CreateObject("scripting.dictionary")
  d("*") = ""
  For i = 1 To UBound(TBlBD)
    d(TBlBD(i, 4)) = ""
  Next i
  temp = d.keys
  Me.ComboBox1.List = temp
  Me.ComboBox1 = "*"
End Sub
 
Private Sub ComboBox1_click()
  NbLignes = Application.CountIf([Tableau1[Classe]], Me.ComboBox1)
  ColRecherche = 4
  clé = Me.ComboBox1: n = 0
  ReDim Tbl(1 To NbLignes, 1 To UBound(TBlBD, 2))
  For i = 1 To UBound(TBlBD)
    If TBlBD(i, ColRecherche) Like clé Then
        n = n + 1
        For k = 1 To UBound(TBlBD, 2): Tbl(n, k) = TBlBD(i, k): Next k
     End If
  Next i
  Me.TextBoxRech = ""
  If n > 0 Then Me.ListBox1.List = Tbl Else Me.ListBox1.Clear
End Sub
 
Private Sub TextBoxRech_Change()
  Dim b()
  If Me.TextBoxRech <> "" Then
   Set d1 = CreateObject("Scripting.Dictionary")
   tmp = Me.TextBoxRech & "*"
   n = 0
   For i = 1 To UBound(Tbl)
      If Tbl(i, 2) Like tmp Then
        n = n + 1: ReDim Preserve b(1 To UBound(Tbl, 2), 1 To n)
        For k = 1 To UBound(Tbl, 2): b(k, n) = Tbl(i, k): Next k
     End If
   Next i
   If n > 0 Then Me.ListBox1.Column = b Else Me.ListBox1.Clear
 Else
   Me.ListBox1.List = Tbl
 End If
End Sub

Boisgontier

[Mr l'Ashanti]

Version avec choix classe par combobox & recherche intuitive sur le nom

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Dim TBlBD(), Tbl()
Private Sub UserForm_Initialize()
  TBlBD = [tableau1].Value        ' pour rapidité
  Me.ListBox1.List = TBlBD
  Me.ListBox1.ColumnCount = [tableau1].Columns.Count
  Me.ListBox1.ColumnWidths = "30;50;50;50;50;50;50;50;50;50;50"
  '------------------------ Alimentation ComboBox
  Set d = CreateObject("scripting.dictionary")
  d("*") = ""
  For i = 1 To UBound(TBlBD)
    d(TBlBD(i, 4)) = ""
  Next i
  temp = d.keys
  Me.ComboBox1.List = temp
  Me.ComboBox1 = "*"
End Sub
 
Private Sub ComboBox1_click()
  NbLignes = Application.CountIf([Tableau1[Classe]], Me.ComboBox1)
  ColRecherche = 4
  clé = Me.ComboBox1: n = 0
  ReDim Tbl(1 To NbLignes, 1 To UBound(TBlBD, 2))
  For i = 1 To UBound(TBlBD)
    If TBlBD(i, ColRecherche) Like clé Then
        n = n + 1
        For k = 1 To UBound(TBlBD, 2): Tbl(n, k) = TBlBD(i, k): Next k
     End If
  Next i
  Me.TextBoxRech = ""
  If n > 0 Then Me.ListBox1.List = Tbl Else Me.ListBox1.Clear
End Sub
 
Private Sub TextBoxRech_Change()
  Dim b()
  If Me.TextBoxRech <> "" Then
   Set d1 = CreateObject("Scripting.Dictionary")
   tmp = Me.TextBoxRech & "*"
   n = 0
   For i = 1 To UBound(Tbl)
      If Tbl(i, 2) Like tmp Then
        n = n + 1: ReDim Preserve b(1 To UBound(Tbl, 2), 1 To n)
        For k = 1 To UBound(Tbl, 2): b(k, n) = Tbl(i, k): Next k
     End If
   Next i
   If n > 0 Then Me.ListBox1.Column = b Else Me.ListBox1.Clear
 Else
   Me.ListBox1.List = Tbl
 End If
End Sub

Boisgontier

le premier code que vous m'avez envoyé fonctionne à merveille. je vais néammoins noter le deuxieme aussi car je dois absolument comprendre les indices que vous utiliser exemple les k, m,a car ça me donnent le vertige.
merci et merci car vous etes beaucoup disponible quand je poste. j'espere etre à un niveau appréciable et aider les autres aussi. merci

[Mr l'Ashanti]

parfait. le deuxieme code que vous m'avez fournit c'est ce que je recherchais pour mon formulaire deuxieme page. si à une reception et l'on demande les refernces de l' élève facile d'abord de saisir sa classe et après le nom.
merci

[Mr l'Ashanti]

bonjour boisgontier. j'espere une bonne forme pour vous ce matin(heure locale).
voici le code que m'a fourni un modérateur de ce forum avec un peu de modification

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 Dim i As Integer
If ComboBox1 <> "" Then
    For i = 0 To ListBox3.ListCount - 1
 
        If ListBox3.Selected(i) = True Then
            Cells(i + 1, 20).Value = ComboBox1.Value
            ListBox3.Column(1, i) = ComboBox1.Value
        End If
 
    Next i
 
        Application.ScreenUpdating = True
 
        End If

je sais que vous ne travaillez pas sur pgm déja établi.
avec le code que vous m'avez donné lorsque j'attribue une décision à un élève ou à plusieurs élèves simultanément la correction à tendance à monter dans la base de donnée, (ligne-1 au lieu de ligne )au lieu de rester sur la ligne comme au début avant que je n'utilise votre code. aussi dans la listbox lors de la correction on peut voir la modif dans la colonne des noms alors que dans la base c'est dans la colonne 20. je note que la modif se fait dans la colonne 20.
en y ajoutant un autre problème (tout en signalant que le code fournit marche correctement donc pas de changement sur votre code) concernant le tri ascendant. cela ne mache plus. j'ai utilisé l'enregistrement de macro pour l'avoir mais avec le nouveau code il y a incompatibilté.
je vous envoie le projet retourché( les erreurs sont à la page 3 et 4du formulaire)

[Mr l'Ashanti]

bonsoir ami boisgonthier.j'espere la grande forme chez vous

je continue d'utiliser votre code sur la recherche intuitive.
mais aujourd'hui il refuse de s'adapter. j'aimerais que vous expliquiez le dysfonctionnement malgré qu'il n' y a pas de débogage
merci