IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

USF avec Listbox paramétrées [XL-2007]


Sujet :

Macros et VBA Excel

  1. #1
    Membre averti
    Homme Profil pro
    Collégien
    Inscrit en
    Juin 2013
    Messages
    32
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Collégien
    Secteur : Transports

    Informations forums :
    Inscription : Juin 2013
    Messages : 32
    Par défaut USF avec Listbox paramétrées
    Bonjour à tous,

    En m'aidant des deux sujets ci dessous :
    La

    Et la

    J'ai cherché à construire un USF me permettant de faire une recherche multi onglet.

    Le fonctionnement est la suivant :
    - On choisit un mapping en 1
    - On choisit un code à chercher en 2
    - On clique sur Results
    - On a les valeurs en sorties en 4

    Les mappings sont toujours de la forme Code + Libellé.
    Tous les mappings en entrée vont vers le même mapping en sortie.

    Ce que je souhaite faire, c'est implémenter une textbox me permettant de faire une recherche via une partie du libellé <= ca j'y arrive (txtbox 6 et listbox 2) mais surtout de lier les resultats de cette recherche au code.

    Actuellement je peux faire la recherche avec une chaine de caractère sur le libellé et sur le code. Le fait de le faire sur le code ne m'interesse pas énormément, cependant est ce une piste interessante pour faire la liaison ?

    En résumé, il me faut lier la liste de code (listbox3) à la liste des libellés (listbox2) qui est fonction du choix de mapping en 1.

    De plus, si je peux éliminer les doublons de mes listes....


    Un GRAND merci d'avance ! et n'hésitez pas si je ne suis pas clair...

    Fichier joint !
    Fichiers attachés Fichiers attachés

  2. #2
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    Bonjour,

    Est-ce que tu peux donner un exemple de ce que tu souhaites ?

  3. #3
    Membre averti
    Homme Profil pro
    Collégien
    Inscrit en
    Juin 2013
    Messages
    32
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Collégien
    Secteur : Transports

    Informations forums :
    Inscription : Juin 2013
    Messages : 32
    Par défaut
    Oui je peux


    Donc je veux chercher dans le mapping MNO;
    le code et le libellé correspondant à Léa.

    Je sélectionne donc MNO en 1,
    Je ne connais plus le code qui correspond a Lea donc je vais sur le deuxieme Textbox (en face de 2) et je tape le.

    A ce moment là, j'ai trois résultats :
    LEA
    Leopoldine
    LEA

    Deja si la je pouvais supprimer les doublons ca serait cool

    Je souhaite que la Listbox du code se mettes à jour pour ne conserver que les codes correspondants aux libellés présent dans la listbox des libellés.

    Si quand je sélectionne d'un coté ça sélectionne de l'autre ca serait un rêve !

    En choisissant LEA, je sais que le code correspondant au prénom est 011223.
    Toutefois si je ne m'en rappele pas il faudrait que quand je sélectionne une valeur dans la liste des libellés, la sélection du code correspondant se fase automatiquement.

    Ensuite je lance ma recherche par le bouton 3- Results. Lui il utilise le code pour faire la recherche.
    En sortie, j'ai le code et le libellé correspondant dans le mapping MNO.
    Soit :
    - 45422 pierre
    et
    - 8958 toto

    En fait je veux lier les deux listes, tout en concervant la possibilité de rechercher par code ou par texte.

    Suis-je plus clair ?

  4. #4
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    Ca a l'air un peu plus compliqué que je ne le pensais. Tu devrais dissocier les recherches soit par texte, soit par code avec un seul listbox et un bouton de choix (texte ou code) Je te mets juste le code de la macro "Remplir pour éviter les doublons :

    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
    Private Sub Remplir()
    Dim q As Range
    Dim Stro As String
    Dim s As Range
    Dim Strs As String
    Dim Dico As Object
     
    Set Dico = CreateObject("Scripting.Dictionary")
    Me.ListBox2.Clear
    Stro = Me.TextBox6.Value
    Stro = "*" & Replace(UCase(Stro), " ", "*") & "*"
    Me.ListBox3.Clear
    Strs = Me.TextBox1.Value
    Strs = "*" & Replace(UCase(Strs), " ", "*") & "*"
    For Each q In Sheets(Me.ListBox1.Value).Range("B3:B" & LastLig)
            If q.Value <> "" Then
                If UCase(q.Value) Like Stro Then
                    If Not Dico.exists(q.Value) Then
                        Dico.Add q.Value, q.Value
                        Me.ListBox2.AddItem q.Value
                        Me.ListBox3.AddItem q.Offset(, -1).Value
                    End If
                End If
            End If
    Next q
     
    'F s
    End Sub

  5. #5
    Expert confirmé Avatar de casefayere
    Homme Profil pro
    RETRAITE
    Inscrit en
    Décembre 2006
    Messages
    5 138
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : RETRAITE
    Secteur : Agroalimentaire - Agriculture

    Informations forums :
    Inscription : Décembre 2006
    Messages : 5 138
    Par défaut
    Un petit fichier exemple que tu devrais pouvoir adapter
    Cordialement,
    Dom
    _____________________________________________
    Vous êtes nouveau ? pour baliser votre code, cliquer sur cet exemple : Anomaly
    pensez à cliquer sur :resolu: si votre problème l'est
    Par contre, il est désagréable de voir une discussion résolue sans message final du demandeur (satisfaction, désarroi, remerciement, conclusion...)

  6. #6
    Membre averti
    Homme Profil pro
    Collégien
    Inscrit en
    Juin 2013
    Messages
    32
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Collégien
    Secteur : Transports

    Informations forums :
    Inscription : Juin 2013
    Messages : 32
    Par défaut
    Deja nickel ton code pour les doublons ! Merci beaucoup.

    Je vais changer mon fusil d'épaule alors pour ma recherche. J'ai modifié mon USF pour enlever la liste des codes et faire soit un choix si on connait le code, soit on chercher par le libellé.

    Le fichier est joint.

    Mon seul soucis étant, Quand je sélectionne mion libellé il faut que mon code correspondant se mette dans le textbox de recherche par code. C'est lui qui est utilisé par le bouton de résultat mais c'est aussi une bonne indication.

    J'ai mis un stop dans le code pour montrer l'endroit ou je tombe.
    Fichiers attachés Fichiers attachés

  7. #7
    Membre averti
    Homme Profil pro
    Collégien
    Inscrit en
    Juin 2013
    Messages
    32
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Collégien
    Secteur : Transports

    Informations forums :
    Inscription : Juin 2013
    Messages : 32
    Par défaut
    Citation Envoyé par casefayere Voir le message
    Un petit fichier exemple que tu devrais pouvoir adapter
    Ha mince, j'ai répondu trop vite, je vais regarder ton fichier. Merci !

  8. #8
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Bonjour
    Utilise plutôt des listbox multi-colonnes mieux que ta conception actuelle (les noms et codes seront attaché sur la même ligne de la listbox)

  9. #9
    Membre averti
    Homme Profil pro
    Collégien
    Inscrit en
    Juin 2013
    Messages
    32
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Collégien
    Secteur : Transports

    Informations forums :
    Inscription : Juin 2013
    Messages : 32
    Par défaut
    Oh pas mal les listbox multicolonnes, je retiens pour un futur projet !

    Pour celui ci je vais me limiter à l'une ou l'autre des recherches.
    Avoir une liste de code ne semble pas une super plus value au final, pcq soit on le connait soit on n'en sait rien...

    Faut juste que je trouve comment répercuter le code quand je choisi le libellé. Une idée ? Deja est-ce le bon endroit où j'ai positionné mon stop ?

  10. #10
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    J'insiste sur la multi-colonne (avec 1ère colonne Code et seconde libellé). Son utilisation future est aisée.

    Regarde ce code, que ce soit par code ou par libellé, ListBox2 est filtrée en conséquence
    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
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    Option Explicit
     
    Dim LastLig As Long
     
    Private Sub UserForm_Initialize()
    Dim Ws As Worksheet
     
    For Each Ws In Worksheets
        If Len(Ws.Name) = 3 Then Me.ListBox1.AddItem Ws.Name
    Next Ws
     
    With Me.ListBox2
        .ColumnCount = 2
        .BoundColumn = 1
        .ColumnWidths = "70;150"
    End With
    End Sub
     
    Private Sub Listbox1_Change()
     
    Me.TextBox1.Value = ""
    Me.TextBox6.Value = ""
    Me.ListBox2.Clear
    If Me.ListBox1.ListIndex > -1 Then
        With Sheets(Me.ListBox1.Value)
            LastLig = .Cells(.Rows.Count, 4).End(xlUp).Row
        End With
        Call Remplir
    End If
    End Sub
     
    Private Sub Remplir(Optional ByVal Str As String, Optional ByVal Code As Boolean)
    Dim Dico As Object
    Dim Ofs As Byte
    Dim c As Range
     
    Me.ListBox2.Clear
    Str = "*" & Replace(UCase(Str), " ", "*") & "*"
    Ofs = Abs(Code)
    Set Dico = CreateObject("Scripting.Dictionary")
    For Each c In Worksheets(Me.ListBox1.Value).Range("A3:A" & LastLig).Offset(0, Ofs)
        If c.Value <> "" Then
            If UCase(c.Value) Like Str Then
                If Not Dico.exists(c.Value) Then
                    Dico.Add c.Value, c.Value
                    With Me.ListBox2
                        .AddItem c.Offset(0, -Ofs).Value
                        .List(.ListCount - 1, 1) = c.Offset(0, 1 - Ofs).Value
                    End With
                End If
            End If
        End If
    Next c
    Set Dico = Nothing
    End Sub
     
    Private Sub TextBox1_Change()
     
    Remplir Me.TextBox1.Value
    End Sub
     
    Private Sub TextBox6_Change()
     
    Remplir Me.TextBox6.Value, True
    End Sub
    PS1. Renomme tes contrôles par des noms significatifs au lieu de ListBox1, TextBox6...

    PS2. Il va rester une petite amélioration au cas ou un filtrage simultané par Code et par libellé.

    PS3. Une bonne conception vaut mieux que des usines à gaz.

  11. #11
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Ma proposition, j'ai renommé les contrôles convenablement. J'ai ensuite supprimé les contrôles non utiles.
    Code en entier de l'Userform
    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
    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
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    Option Explicit
     
    Dim LastLig As Long
     
    Private Sub UserForm_Initialize()
    Dim Ws As Worksheet
     
    For Each Ws In Worksheets
        If Len(Ws.Name) = 3 Then Me.LstMap.AddItem Ws.Name
    Next Ws
     
    With Me.LstFiltre
        .ColumnCount = 2
        .BoundColumn = 1
        .ColumnWidths = "70;150"
    End With
     
    With Me.LstResult
        .ColumnCount = 2
        .BoundColumn = 1
        .ColumnWidths = "70;150"
    End With
    End Sub
     
    Private Sub LstMap_Change()
     
    Me.TbCode.Value = ""
    Me.TbLibel.Value = ""
    Me.LstFiltre.Clear
    If Me.LstMap.ListIndex > -1 Then
        With Sheets(Me.LstMap.Value)
            LastLig = .Cells(.Rows.Count, 4).End(xlUp).Row
        End With
        Call Remplir
    End If
    End Sub
     
    Private Sub Remplir(Optional ByVal Str As String, Optional ByVal Code As Boolean)
    Dim Dico As Object
    Dim Ofs As Byte
    Dim c As Range
     
    Me.LstFiltre.Clear
    Str = "*" & Replace(UCase(Str), " ", "*") & "*"
    Ofs = Abs(Code)
    Set Dico = CreateObject("Scripting.Dictionary")
    For Each c In Worksheets(Me.LstMap.Value).Range("A3:A" & LastLig).Offset(0, Ofs)
        If c.Value <> "" Then
            If UCase(c.Value) Like Str Then
                If Not Dico.exists(c.Value) Then
                    Dico.Add c.Value, c.Value
                    With Me.LstFiltre
                        .AddItem c.Offset(0, -Ofs).Value
                        .List(.ListCount - 1, 1) = c.Offset(0, 1 - Ofs).Value
                    End With
                End If
            End If
        End If
    Next c
    Set Dico = Nothing
    End Sub
     
    Private Sub TbCode_Change()
     
    Remplir Me.TbCode.Value
    End Sub
     
    Private Sub TbLibel_Change()
     
    Remplir Me.TbLibel.Value, True
    End Sub
     
    Private Sub LstFiltre_Change()
    Dim Code As String
    Dim c As Range
     
    Me.LstResult.Clear
    If Me.LstFiltre.ListIndex > -1 Then
        Code = Me.LstFiltre.Value
        For Each c In Worksheets(Me.LstMap.Value).Range("A3:A" & LastLig)
            If c.Value = Code Then
                With Me.LstResult
                    .AddItem c.Offset(0, 2).Value
                    .List(.ListCount - 1, 1) = c.Offset(0, 3).Value
                End With
            End If
        Next c
    End If
    End Sub
     
    Private Sub BtnReset_Click()
     
    Me.LstMap.ListIndex = -1
    End Sub
     
    Private Sub BtnExit_Click()
     
    Unload Me
    End Sub

    Fichier d'illustration

  12. #12
    Membre averti
    Homme Profil pro
    Collégien
    Inscrit en
    Juin 2013
    Messages
    32
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Collégien
    Secteur : Transports

    Informations forums :
    Inscription : Juin 2013
    Messages : 32
    Par défaut
    Bon, tu m'as convaincu ! Ton travail est super au niveau optimisation du code, je suis bluffé !

    En regardant plus attentivement, j'ai essayé hier soir de mettre en place la possibilité de copier coller le résultat. Ne trouvant pas dans les propriétés, j'ai choisi d'implenter ca :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    Private Sub lot_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        Dim NumCopie As String  
          If KeyAscii = 3 Then
            NumCopie = lot.List(lot.ListIndex)
            With New DataObject
                .SetText NumCopie
                .PutInClipboard
            End With
        End If
    End Sub
    J'ai bien la Bibliothèque MicroSoft Forms 2.0 Object Library. Toutefois ca ne semble pas fonctionner. Une idée ?

    De plus, dans la liste des résultats, ces derniers apparaissaient préalablement sans doublons. Toutefois je n'ai toujours pas compris la technique du
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
                Prem = c.Address
                Do
                    Label = c.Offset(, F).Value
                    Tmp = c.Offset(, E - F).Value
                    If InStr(Str2, Tmp) = 0 Then Str2 = Str2 & vbNewLine & Tmp
                    Tmp = c.Offset(, E - F + 1).Value
                    If InStr(Str3, Tmp) = 0 Then Str3 = Str3 & vbNewLine & Tmp
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Prem
                Str2 = Mid(Str2, 2)
                Str3 = Mid(Str3, 2)
    qui était préalablement implenté.

    Dans tous les cas, dors et déjà un grand merci !

  13. #13
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Bonjour
    Nouvelle demande - nouveau sujet avec explication claire et détaillée du problème.
    Là, on ne te suit pas.

  14. #14
    Membre averti
    Homme Profil pro
    Collégien
    Inscrit en
    Juin 2013
    Messages
    32
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Collégien
    Secteur : Transports

    Informations forums :
    Inscription : Juin 2013
    Messages : 32
    Par défaut
    Citation Envoyé par mercatog Voir le message
    Bonjour
    Nouvelle demande - nouveau sujet avec explication claire et détaillée du problème.
    Là, on ne te suit pas.
    Done

    Pour les doublons j'ai fait ca comme ceci :
    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
    Private Sub SupDoubles()
     
         Dim iPos As Integer
         iPos = 0
         'Si la listbox est vide il quitte la fonction
         If LstResult.ListCount < 1 Then Exit Sub
     
         Do While iPos < LstResult.ListCount
         LstResult.Text = LstResult.List(iPos)
         'Verifie si le text existe deja
     
         If LstResult.ListIndex <> iPos Then
         'Si c'est le cas il supprime et garde la position iPos...
         LstResult.RemoveItem iPos
         Else
         'Si ce n'est pas le cas il change la position iPos...
         iPos = iPos + 1
         End If
         Loop
     
    End Sub

  15. #15
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    As-tu des doublons dans LstResult?

    Si c'est le cas, utilise un Dictionnaire comme pour LstFiltre.

    Non?

    Pour remplir ensuite supprimer?

    PS. Si tu n'arrives pas, on peux te guider mais regarde le fonctionnement de la Sub Remplir.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [e-07]initialisation USF avec 3 listbox
    Par casefayere dans le forum Macros et VBA Excel
    Réponses: 8
    Dernier message: 20/04/2009, 14h51
  2. [ADO/Access] Appel d’une requête avec des paramètres
    Par Taxenna dans le forum Bases de données
    Réponses: 1
    Dernier message: 07/12/2004, 14h58
  3. Problème avec les paramètres date BDE/ODBC Oracle/XP Pro
    Par Bloon dans le forum Bases de données
    Réponses: 3
    Dernier message: 06/10/2004, 10h09
  4. Erreur sur une fonction avec des paramètres
    Par Elois dans le forum PostgreSQL
    Réponses: 2
    Dernier message: 05/05/2004, 21h00
  5. créer un noeuds avec des paramétres
    Par Toxine77 dans le forum XMLRAD
    Réponses: 5
    Dernier message: 21/01/2003, 16h11

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo