Double clic et colonne dans une listbox.

Version imprimable

1 pièce(s) jointe(s)

Bonsoir,
J'ai actuellement un userform me permettant de rechercher toutes les valeurs dans mon tableau.
Mais je trouve que la présentation des données dans la listbox n'est pas esthétiques ( colonne séparé par des * et non-alignées...)
De plus, je n'est pas la barre pour aller de gauche à droite dans la listbox et je ne sait pas comment l'ajouter.
Dans mon code , il y a le sub double clic , mais au double clic dans la listbox rien ne se passe je ne comprends pas ..
Merci de votre aide !
Voici le fichier ci-joint et le code plus bas.
Cordialement,

Code:

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Private O As Worksheet 'déclare la variable O (Onglet)
Private TC As Variant 'déclare la variable TC (Tableau de Cellules)
Private NL As Integer 'déclare la variable NL (Nombre de Lignes)
Private NC As Integer 'déclare la variable NC (Nombre de Colonnes)
 
 
 
 
 
Dim f, choix(), Rng
Private Sub UserForm_Initialize()
   Set f = Sheets("RECAPITULATIF")
   Set Rng = f.Range("a3:s" & f.[a65000].End(xlUp).Row)
   TblTmp = Rng.Value
   For I = LBound(TblTmp) To UBound(TblTmp)
     ReDim Preserve choix(1 To I)
     For K = LBound(TblTmp) To UBound(TblTmp, 2)
       choix(I) = choix(I) & TblTmp(I, K) & " * "
     Next K
   Next I
   Me.ListBox1.List = choix
End Sub
 
Private Sub TextBox1_Change()
   mots = Split(Trim(Me.TextBox1), " ")
   Tbl = choix
   For I = LBound(mots) To UBound(mots)
     Tbl = Filter(Tbl, mots(I), True, vbTextCompare)
   Next I
   Me.ListBox1.List = Tbl
   Me.Label1.Caption = UBound(Tbl) + 1
 
End Sub
 
 
Private Sub ListBox1_DblClick(ByVal Cancel As msforms.ReturnBoolean) 'au double-clic dans la ListBox1
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (Incrément)
Dim LeParcours As String
 
For I = 0 To Me.ListBox1.ListCount - 1 'Boucle 1 : sur toutes les lignes de la ListBox1
 
    If Me.ListBox1.Selected(I) = True Then 'condition 1 : si la ligne est sélectionnée
        For J = 2 To NL 'boucle 2 : sur toutes les lignes du tabelau TC
            If TC(J, 2) = Me.ListBox1.Column(1, I) Then 'condition 2 : si les numéros de HYD sont égaux
                O.Rows(J + 1).Select    'sélecionne la ligne J de l'onglet O
 
                LeParcours = Me.ListBox1.Column(1, I)
                Chemin = "C:/Users/nathan/dropbox1/HYD/HYD" & LeParcours & "\"
           Application.DisplayFullScreen = False
 
 
    ThisWorkbook.FollowHyperlink Chemin
Unload Me
 
 
 
                 'vide et ferme l'Usersorm
 
 
 
 
                Exit Sub 'sort de la procédure
            End If 'fin de la condition 2
        Next J 'prochaine ligne de la boucle 2
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle 1
 
 
 
 
End Sub

Pièce jointe 224133

04/11/2016, 23h12
unparia

Bonjour
je lis :

Code:

For J = 2 To NL 'boucle 2 : sur toutes les lignes du tabelau TC

mais ne vois pas où NL a été initialisée. Donc NL = 0. Et une boucle de 2 à 0, ma foi ... est une boucle qui ne commence même pas :D
(et lorsque je vois un tel soin, je ne regarde même pas le reste).

A moins qu'initialisée ailleurs dans le reste du code que je ne vois pas, puisque je n'ouvre jamais un classeur tiers ...
04/11/2016, 23h22
Patouillou

Désolé j'ai modifier tout mon sujet ... Étant donné que j'ai abandonné l'autre problème qui m'avait pas l'air très fiable... Et je suis passé à quelque chose de plus simple.

1 pièce(s) jointe(s)

Bonjour,

Pour la présentation en colonnes dans la ListBox
La recherche se fait dans toutes les colonnes de la BD et sur tous les mots saisis dans le textbox

Code:

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
 
Dim f, choix(), Rng, Ncol
Private Sub UserForm_Initialize()
   Set f = Sheets("recapitulatif")
   Set Rng = f.Range("a3:R" & f.[a65000].End(xlUp).Row)
   TblTmp = Rng.Value
   Ncol = Rng.Columns.Count
   For I = LBound(TblTmp) To UBound(TblTmp)
     ReDim Preserve choix(1 To I)
     For k = LBound(TblTmp) To UBound(TblTmp, 2)
       choix(I) = choix(I) & TblTmp(I, k) & " * "
     Next k
   Next I
   Me.ListBox1.List = Rng.Value
End Sub
 
Private Sub TextBox1_Change()
   If Me.TextBox1 <> "" Then
     mots = Split(Trim(Me.TextBox1), " ")
     Tbl = choix
     For I = LBound(mots) To UBound(mots)
       Tbl = Filter(Tbl, mots(I), True, vbTextCompare)
     Next I
       n = 0: Dim b()
       For I = LBound(Tbl) To UBound(Tbl)
         a = Split(Tbl(I), "*")
         n = n + 1: ReDim Preserve b(1 To Ncol, 1 To n)
         For k = 1 To Ncol
           b(k, I + 1) = a(k - 1)
         Next k
       Next I
       If n > 0 Then
         ReDim Preserve b(1 To Ncol, 1 To n + 1)
         Me.ListBox1.List = Application.Transpose(b)
         Me.ListBox1.RemoveItem n
       End If
       Me.Label1.Caption = UBound(Tbl) + 1
   Else
    UserForm_Initialize
  End If
End Sub

Quel est le but du double clic?

Boisgontier
http://boisgontierjacques.free.fr

Bonjour,
Merci pour ton code, il fonctionne très bien, j'ai réussi a redimensionner les colonnes pour voir toutes les info.. Mais comment mettre la colonne des montant en euro ? C'est a dire qu'un lieu d'afficher 250 , ça devrait afficher 250€ ...
Ensuite, le double clic me sert a ouvrir un dossier . En effet , pour chaque intervention , e dispose d'un dossier qui porte le nom de l'intervention. En fait ce code marchait très bien dans mon ancien "rechercher" . Et je n'arrive pas à l'incorporer dans ton code... Je vous envoie le code de l'ancien userform pour que vous compreniez comment celui ci marchait.
Merci de votre aide !
Ps : j'ai changer de code parce qu'il ne me permettait de recherche qu'une info, alors que je dois pouvoir chercher dans tout le tableau...
Voici l'ancien code :

Code:

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
Private Sub UserForm_initialize() 'à l'initialisation de l'UserForm
Set o = Sheets("RECAPITULATIF") 'définit l'onglet O
TC = o.Cells(2, 1).Resize(o.UsedRange.Rows.Count - 2, 17) 'définit le tableau de cellules TC
NL = UBound(TC, 1) 'définit le nombre de ligne NL
NC = UBound(TC, 2) 'définit le nombre de colonnes NC
Me.ListBox1.ColumnCount = NC 'définit le nombre de colonne de la ListBox1
End Sub
 
Private Sub TextBox1_Change() 'au changement dans la Textbox1
Dim i As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable L (incrément)
Dim TOT() As Variant 'déclare la variable TOT (Tableau des Occcurrences Trouvées)
Dim L As Integer 'déclare la variable L (incrément)
 
If Me.TextBox1.Value = "" Then 'condition : si la Textbox1 est effacée
    Me.ListBox1.Clear 'vide la ListBox1
    Me.Label1.Caption = "" 'efface la Label1
    Exit Sub 'sort de la procédure
End If 'fin de la condition
Me.ListBox1.Clear 'vide la ListBox1
K = 1 'initialise la variable K
For i = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau de cellule TC (en partant de la seconde)
    For J = 1 To NC 'boucle 2 : sur toutes les colonnes J du tableau de cellules TC
        'condition : si la valeur de la TetxBox1 est contenue dans la valeur ligne I colonne J de TC
        If UCase(TC(i, J)) Like "*" & UCase(Me.TextBox1.Value) & "*" Then
            'redimensionne le tableau des occurrences trouvées TOT (autant de lignes que TC a de colonnes, K colonnes)
            ReDim Preserve TOT(1 To NC, 1 To K)
            For L = 1 To NC 'boucle 3 : sur toutes les colonnes de TC
                TOT(L, K) = TC(i, L) 'alimente la ligne du tableau TOT avec la colonne du tableau TC
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémete K (nouvelle colonne pour TOT)
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next J 'prochaine colonne de la boucle 2
Next i 'prochaine ligne de la boucle 1
On Error Resume Next 'gestion des erreur (en cas d'erreur passe à la ligne suivante)
'si le tableau TOT ne contient qu'une seule ligne, ajoute une seconde ligne vide (sinon les données sans dans une seule colonne...)
If UBound(TOT, 2) = 1 Then ReDim Preserve TOT(1 To NC, 1 To 2)
'alimente la ListBox1 avec le tableau TOT transposé (ligne/Colonne)
Me.ListBox1.List = Application.Transpose(TOT) 'génère une erreur si TOT est vide
'si une erreur a été générée, message, sort de la procédure
If Err <> 0 Then Me.Label1.Caption = "Aucune occurrence trouvée !": Exit Sub
Me.Label1.Caption = K - 1 & IIf(K - 1 = 1, " occurrence trouvé !", " occurrences trouvées !")
End Sub
 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'au double-clic dans la ListBox1
Dim i As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (Incrément)
Dim LeParcours As String
 
For i = 0 To Me.ListBox1.ListCount - 1 'Boucle 1 : sur toutes les lignes de la ListBox1
 
    If Me.ListBox1.Selected(i) = True Then 'condition 1 : si la ligne est sélectionnée
        For J = 2 To NL 'boucle 2 : sur toutes les lignes du tabelau TC
            If TC(J, 2) = Me.ListBox1.Column(1, i) Then 'condition 2 : si les numéros de HYD sont égaux
                o.Rows(J + 1).Select    'sélecionne la ligne J de l'onglet O
 
                LeParcours = Me.ListBox1.Column(1, i)
                Chemin = "C:/Users/emmanuel-baigne/dropbox/HYD/HYD" & LeParcours & "\"
           Application.DisplayFullScreen = False
 
 
    ThisWorkbook.FollowHyperlink Chemin
Unload Me
 
 
 
                 'vide et ferme l'Usersorm
 
 
 
 
                Exit Sub 'sort de la procédure
            End If 'fin de la condition 2
        Next J 'prochaine ligne de la boucle 2
    End If 'fin de la condition 1
Next i 'prochaine ligne de la boucle 1
 
 
 
 
End Sub

1 pièce(s) jointe(s)

On peut frapper 2015 Rennes ici
J'ai remplacé le double clic par le bouton OK

Code:

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
 
Dim f, choix(), Rng, Ncol, Nlig, TC()
Private Sub UserForm_Initialize()
   Set f = Sheets("recapitulatif")
   Set Rng = f.Range("A3:R" & f.[a65000].End(xlUp).Row)
   TblTmp = Rng.Value
   For i = LBound(TblTmp) To UBound(TblTmp)
     TblTmp(i, 9) = TblTmp(i, 9) & "€"
   Next i
   TC = TblTmp
   Ncol = Rng.Columns.Count
   Nlig = Rng.Rows.Count
   For i = LBound(TblTmp) To UBound(TblTmp)
     ReDim Preserve choix(1 To i)
     For k = LBound(TblTmp) To UBound(TblTmp, 2)
       choix(i) = choix(i) & TblTmp(i, k) & " * "
     Next k
   Next i
   Me.ListBox1.List = TblTmp
End Sub
 
Private Sub TextBox1_Change()
   If Me.TextBox1 <> "" Then
     mots = Split(Trim(Me.TextBox1), " ")
     Tbl = choix
     For i = LBound(mots) To UBound(mots)
       Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
     Next i
       n = 0: Dim b()
       For i = LBound(Tbl) To UBound(Tbl)
         a = Split(Tbl(i), "*")
         n = n + 1: ReDim Preserve b(1 To Ncol, 1 To n)
         For k = 1 To Ncol
           b(k, i + 1) = a(k - 1)
           If k = 9 Then b(k, i + 1) = b(k, i + 1) & " €"
         Next k
       Next i
       If n > 0 Then
         ReDim Preserve b(1 To Ncol, 1 To n + 1)
         Me.ListBox1.List = Application.Transpose(b)
         Me.ListBox1.RemoveItem n
       End If
       Me.Label1.Caption = UBound(Tbl) + 1
   Else
    UserForm_Initialize
  End If
End Sub
 
Private Sub CommandButton1_Click()
  Set O = Sheets("recapitulatif")
  For i = 0 To Me.ListBox1.ListCount - 1 'Boucle 1 : sur toutes les lignes de la ListBox1
    If Me.ListBox1.Selected(i) = True Then 'condition 1 : si la ligne est sélectionnée
        For J = 1 To Nlig 'boucle 2 : sur toutes les lignes du tabelau TC
            If TC(J, 2) = Val(Me.ListBox1.Column(1, i)) Then 'condition 2 : si les numéros de HYD sont égaux
                O.Rows(J + 2).Select    'sélecionne la ligne J de l'onglet O
                LeParcours = Trim(Me.ListBox1.Column(1, i))
                Chemin = "C:/Users/emmanuel-baigne/dropbox/HYD/HYD" & LeParcours & "\"
           Application.DisplayFullScreen = False
           ThisWorkbook.FollowHyperlink Chemin
           Unload Me
           Exit Sub 'sort de la procédure
         End If 'fin de la condition 2
       Next J 'prochaine ligne de la boucle 2
    End If 'fin de la condition 1
 Next i 'prochaine ligne de la boucle 1
End Sub

Boisgontier

05/11/2016, 14h31
Patouillou

Bonjour et merci.
J'ai remis la sélection en double -clic car plus rapide.
Dernière chose sur ma listbox, il y a la ligne dans laquelle se trouve mes montant , la ligne I .
Et je n'arrive pas à faire un peu comme pour le label , c'est à dire additionner toutes les valeur de la colonne I du listbox et afficher le résultat dans un label .. Merci !
05/11/2016, 17h03
boisgontierjacques

1 pièce(s) jointe(s)

Voir PJ

Boisgontier
http://boisgontierjacques.free.fr