XL 2013 Userform recherche - Listbox double clic renvoi vers cellule

[CGU2022.]

Bonjour le Forum....

J'ai un Userform de "Recherche" (ce n'ai pas moi qui l'ai codé), j'essaye de l'adapter à mon projet.
Je l'affectionne car la recherche est très intuitive, peux importe le nombre de mots ou lettres.




Option Compare Text ' Pas de différence entre minuscule/majuscule

Dim f, choix(), Rng, BD(), ncol, ColVisu()

Private Sub UserForm_Initialize()

Me.ListBox1.ColumnHeads = True 'Affiche l'entete de colonne dans la listbox pour test

Set f = ActiveSheet 'Feuille active
ColVisu = Array(1, 2, 3, 4, 5, 6) 'colonnes à visualiser

Set Rng = f.Range("A12:N" & f.[A65000].End(xlUp).Row) 'valeur base saisie
BD = Rng.Value
ncol = UBound(ColVisu) + 1

Me.ListBox1.ColumnCount = UBound(ColVisu) + 1
Me.ListBox1.ColumnWidths = temp

TblTmp = Rng.Value
For i = LBound(BD) To UBound(BD)
ReDim Preserve choix(1 To i)
For Each K In ColVisu
choix(i) = choix(i) & BD(i, K) & " * "
Next K
Next i

'--- valeurs initiales dans ListBox
Dim Tbl(): ReDim Tbl(1 To UBound(BD), 1 To ncol)
For i = 1 To UBound(BD)
c = 0
For Each K In ColVisu
c = c + 1: Tbl(i, c) = BD(i, K)
Next K
Next i

End Sub


Private Sub Txt_label_Change()

If Me.Txt_label <> "" Then
mots = Split(Trim(Me.Txt_label), " ")
Tbl = choix
For i = LBound(mots) To UBound(mots)
Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
Next i
If UBound(Tbl) > -1 Then
Dim b(): ReDim b(1 To UBound(Tbl) + 1, 1 To ncol)
For i = LBound(Tbl) To UBound(Tbl)
a = Split(Tbl(i), "*")
For K = 1 To ncol: b(i + 1, K) = a(K - 1): Next K
Next i
Me.ListBox1.List = b
Me.Label1.Caption = UBound(Tbl) + 1 & " Ligne(s)" '+ 1 depart compte ligne
End If
Else

UserForm_Initialize
End If

End Sub



J'ai du mal à y insérer un code de ce type:

'ICI C'est la sélection au Double Click & Sortie du UserForm
Private Sub ListBox1_dblClick(ByVal Cancel As MSForms.ReturnBoolean)
With ListBox1

'atteint la cellule (définie par la la colonne 6 (cachée) de la ligne double-cliquée) dans l'onglet (défini par la colonne 0 de la ligne double-cliquée)
Application.Goto Sheets(ActiveSheet.Name).Range(.List(.ListIndex, 5))
End With 'fin de la prise en compte de la ListBox
End Sub


Qui permet de sélectionner une cellule (ou ligne) par dble click dans la listbox.

Pouvez vous m'aider ?
Merci..

 

[Lolote83]

Bonjour,
Je n'ai peut être pas tout compris dans votre demande.
Dans le fichier joint, sur Dbl_Clic on sélectionne ensuite la cellule colonne A puis fermeture du formulaire

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    xLigEnteteTablo = 11
    xLig = ListBox1.ListIndex + 1
    Range("A" & xLigEnteteTablo + xLig).Select
    Unload Me
End Sub

@+ Lolote83

 

[Gégé-45550]

Bonjour,
je vous propose d'essayer ceci :

Private Sub ListBox1_dblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim indice, sel1, sel2
    indice = Me.ListBox1.ListIndex
    sel1 = Me.ListBox1.List(indice, 0) 'en deuxième position, le numéro de la colonne qui vous intéresse'
    sel2 = Me.ListBox1.List(indice, 5) 'en deuxième position, le numéro de la colonne qui vous intéresse'
    'Appeler ici une procédure qui permet d'atteindre la cellule voulue, dans l'onglet voulu
    ' cette procédure doit se terminer par la ligne 'UserFormrecherche.Unload'
End Sub

Bonne journée

 

[Jacky67]

Bonjour le Forum....
J'ai du mal à y insérer un code de ce type:

'ICI C'est la sélection au Double Click & Sortie du UserForm
Private Sub ListBox1_dblClick(ByVal Cancel As MSForms.ReturnBoolean)
With ListBox1

'atteint la cellule (définie par la la colonne 6 (cachée) de la ligne double-cliquée) dans l'onglet (défini par la colonne 0 de la ligne double-cliquée)
Application.Goto Sheets(ActiveSheet.Name).Range(.List(.ListIndex, 5))
End With 'fin de la prise en compte de la ListBox
End Sub


Qui permet de sélectionner une cellule (ou ligne) par dble click dans la listbox.

Pouvez vous m'aider ?
Merci..

Bonjour à tous

Cela pourrait ressembler à ceci

Private Sub ListBox1_dblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim col&
    col = 4   'Active la colonne "Quant"(4) ** A adapter
    With Feuil1
        .Cells(Application.Match(Trim(ListBox1.Column(0)), .[a:a], 0), col).Activate
    End With
    Unload UserFormrecherche
End Sub

 

[CGU2022.]

Bonjour,
Je n'ai peut être pas tout compris dans votre demande.
Dans le fichier joint, sur Dbl_Clic on sélectionne ensuite la cellule colonne A puis fermeture du formulaire

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    xLigEnteteTablo = 11
    xLig = ListBox1.ListIndex + 1
    Range("A" & xLigEnteteTablo + xLig).Select
    Unload Me
End Sub

@+ Lolote83

Bonjour Lolote83
Merci pout ta réponse cela marche si la listbox est complètement chargée (sans filtre)..

 

[CGU2022.]

Bonjour,
je vous propose d'essayer ceci :

Private Sub ListBox1_dblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim indice, sel1, sel2
    indice = Me.ListBox1.ListIndex
    sel1 = Me.ListBox1.List(indice, 0) 'en deuxième position, le numéro de la colonne qui vous intéresse'
    sel2 = Me.ListBox1.List(indice, 5) 'en deuxième position, le numéro de la colonne qui vous intéresse'
    'Appeler ici une procédure qui permet d'atteindre la cellule voulue, dans l'onglet voulu
    ' cette procédure doit se terminer par la ligne 'UserFormrecherche.Unload'
End Sub

Bonne journée

Bonjour Gégé-45550 merci d'avoir pris de ton temps pour me répondre mais je n'arrive pas a faire fonctionner ce code, je vais y revenir plus tard....

 

[CGU2022.]

Bonjour à tous

Cela pourrait ressembler à ceci

Private Sub ListBox1_dblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim col&
    col = 4   'Active la colonne "Quant"(4) ** A adapter
    With Feuil1
        .Cells(Application.Match(Trim(ListBox1.Column(0)), .[a:a], 0), col).Activate
    End With
    Unload UserFormrecherche
End Sub

Merci [SIZE=4]Jacky67[/SIZE] je vais utiliser ton code... Bon week-end...​

 

[CGU2022.]

Un grand merci ...