ListBox vers plusieurs TextBox

scuba

XLDnaute Nouveau
Bonsoir à tous.
Cela fait 2 semaines que je coince sur un problème de copie de ListBox vers plusieurs TexBox.
J'alimente une ListBox appelée LstResultat placée dans l'UsForm UsrFind qui m'affiche les 8 résultats sur 1 ligne.
Sous la ListBox, j'ai un bouton Modifier liste sélectionnée qui devrait, lorsqu'un ligne est sélectionnée dans la ListBox, copier les divers éléments (il y en a 8) de cette liste dans une UsForm appelée UserForm1,
Je peux modifier le contenu des TextBox et en validant, les modifs sont intégrées dans le tableau Table1 de la Feuille1 appelée Table.
Evidemment je n'arrive pas en saisissant une ligne dans la ListBox à appeler l'UsForm1.
Un petit coup de main serait le bienvenu.
Dans le fichier joint, utiliser le bouton Modifier pour accéder à l'UsForm UsrFind où tout se passe.
Sélectionner Nom avec le bouton radio, puis un nom (le par exemple) pour afficher la ListBox remplie.
Actuellement en cliquant sur le bouton Modifier liste sélectionnée je passe par une ImputBox pour afficher l'UsForm de modification.
Evidemment je souhaite utiliser la ListBox et non une Imputbox.
Merci pour votre aide. Elle m'enlèvera une grosse épine du pied.
Inutile de vous dire que je débute.
 

Pièces jointes

  • repertoire.xlsm
    64.9 KB · Affichages: 78
  • repertoire.xlsm
    64.9 KB · Affichages: 92
  • repertoire.xlsm
    64.9 KB · Affichages: 89

Bebere

XLDnaute Barbatruc
Re : ListBox vers plusieurs TextBox

bonjour Scuba
bienvenue

une possiblité

Code:
Private Sub LstResultat_Change()
Dim I As Byte

    If Me.LstResultat <> "" Then
        With UserForm1
            For I = 1 To 8
                .Controls("Textbox" & I) = Me.LstResultat.List(Me.LstResultat.ListIndex, I - 1)
            Next I
            Unload Me
            .Show
        End With
    End If

End Sub
 

CHALET53

XLDnaute Barbatruc
Re : ListBox vers plusieurs TextBox

Bonjour Scuba et Bebere

J'avais fait quelque chose : je le joins également

La suppression de la ligne dans la liste intervient dans le userform1

Pourquoi supprimer de la listbox sans supprimer du fichier ?
a+
 

Pièces jointes

  • scuba.xlsm
    61.2 KB · Affichages: 71

scuba

XLDnaute Nouveau
Re : ListBox vers plusieurs TextBox

Bonjour Bebere,CHALET53 et laetitia90.

Merci pour vos réponses rapides.
C'est certain que vous faites avancer le bouchon.
Le projet de laetitia90 me plait bien mais suppose une refonte complète de mon projet.
Tout se fait sur une seule Form.

Quelques interrogations toutefois.

Pour Bebere:
Lorsque j'exécute ton code, j'obtiens une erreur 1004 Erreur définie par l'application ou l'objet (erreur sur whith UserForm1)
si je clique sur une ligne dans la ListBox.

Pour CHALET53:
L'appel de l'UserForm1 se fait si l'on clique sur une ligne dans la ListBox.
Y a-t-il possibilité que l'appel de UserForm1 s'exécute seulement si on clique sur le bouton "Modifier liste sélectionnée".

J'ai fait un test en supprimant la 1ère ligne de la ListBox qui en contient 2 ( recherche sur l par le nom).
La suppression de la ligne s'effectue mais si je sélectionne la liste restante, l'appel de UserForm1 ne se fait pas.
Il faut recréer les listes pour y avoir accès.

Pour laetitia90:
J'ai appliqué ta méthode mais pas encore eu le temps d'approfondir. Elle me semble intéressante, mais pas sûr que je sois capable d'avancer.

Merci encore à tous les 3.
Je n'ai pas encore décidé vers quelle version je m'orienterai.
Néanmoins vous pouvez toujours me répondre sur les interrogations ci-dessus.
Je progresserai de cette façon.
Encore merci.
 

scuba

XLDnaute Nouveau
Re : ListBox vers plusieurs TextBox

Merci CHALET53.

C'est en effet quelque chose qui me plait.
Petite précision.
Le bouton "Annuler" supprime la ligne de la ListBox.
Pourrait-il aussi supprimer la ligne dans le tableau "Table1".
Et je pense qu'on aura fait le tour de la question.

Histoire de faire beau, y a-t-il possibilité de ne faire apparaître les champs de modif que seulement si une ligne est sélectionnée dans ListBox.

Je continue à explorer la proposition de laetitia90 qui m'ouvre d'autres horizons.
 

CHALET53

XLDnaute Barbatruc
Re : ListBox vers plusieurs TextBox

Qu'appelles-tu Table1 ?
Le bouton Supprimer enlève l'individu de la listbox
Le bouton Annuler remet à blanc les textboxs

Je ne vois pas pourquoi tu veux supprimer un élément de la Listbox (avec le bouton supprimer)
En général, on réserve cette option pour supprimer de la base l'élément sélectionné de la listbox

a+
 

Bebere

XLDnaute Barbatruc
Re : ListBox vers plusieurs TextBox

bonjour Laetitia,Chalet
l'erreur vient de userform1_initialise
il faut différencier les 2 codes si tu les gardes tous les deux
un autre code pour initialiser TAB1 dans bouton rechercher
le code qui existe introduit des lignes vides dans la listbox

Code:
Private Sub BtnRecherche_Click()    'MODE RECHERCHE STRING
    Dim Cell As Range
    Dim TAB1()
    Dim I As Byte
    Dim L As Byte
    ' facon de rechercher en fonction du bouton activé, client, Marché ou N° de marché
    If btnNom.Value = False And BtnMarche.Value = False And BtnNmr = False Then
        MsgBox "Vous devez choisir un type de recherche !!", vbCritical + vbOKOnly, "Attention ..."
        Exit Sub
    End If

    If btnNom.Value = True Then    '<- Bouton Nom
        If TxtQuoi.Value <> "" Then

            L = Len(TxtQuoi)
            For Each Cell In Sheets("Table").Range("A2", "A" & Range("A65536").End(xlUp).Row)
                If UCase(Left(Cell.Text, L)) = UCase(TxtQuoi.Text) Then
                    I = I + 1
                    ReDim Preserve TAB1(1 To 8, 1 To I)
                    For c = 1 To 8
                        TAB1(c, I) = Sheets("Table").Cells(Cell.Row, c)
                    Next c
                End If
            Next Cell
        Else
            MsgBox "Veuillez entrer un critère de recherche", vbInformation + vbOKOnly, "Erreur de recherche"
            Exit Sub
        End If
        LstResultat.Visible = True
        LstResultat.ColumnCount = 8
        LstResultat.ColumnWidths = "4cm" & ";" & "4cm" & ";" & "3cm" & ";" & "3cm" & ";" & "6cm" & ";" & "7cm" & ";" & "1,5cm" & ";" & "7cm"


    ElseIf BtnMarche.Value = True Then    '<- Bouton Code postal
        If TxtQuoi.Value <> "" Then
            L = Len(TxtQuoi)
            For Each Cell In Sheets("Table").Range("G2", "G" & Range("A65536").End(xlUp).Row)
                If UCase(Left(Cell.Text, L)) = UCase(TxtQuoi.Text) Then
                    I = I + 1
                    ReDim Preserve TAB1(1 To 8, 1 To I)
                    For c = 1 To 8
                        TAB1(c, I) = Sheets("Table").Cells(Cell.Row, c)
                    Next c
                End If
            Next Cell
        Else
            MsgBox "Veuillez entrer un critère de recherche", vbInformation + vbOKOnly, "Erreur de recherche"
            Exit Sub
        End If
        LstResultat.Visible = True
        LstResultat.ColumnCount = 8
        LstResultat.ColumnWidths = "1,5cm" & ";" & "4cm" & ";" & "4cm" & ";" & "3cm" & ";" & "3cm" & ";" & "6cm" & ";" & "7cm" & ";" & "7cm"
'        LstResultat.List = TAB1()


    ElseIf BtnNmr.Value = True Then    '<- Bouton Ville
        If TxtQuoi.Value <> "" Then
            L = Len(TxtQuoi)
            For Each Cell In Sheets("Table").Range("H2", "H" & Range("A65536").End(xlUp).Row)
                If UCase(Left(Cell.Text, L)) = UCase(TxtQuoi.Text) Then
                    I = I + 1
                    ReDim Preserve TAB1(1 To 8, 1 To I)
                    For c = 1 To 8
                        TAB1(c, I) = Sheets("Table").Cells(Cell.Row, c)
                    Next c
                End If
            Next Cell
        Else
            MsgBox "Veuillez entrer un critère de recherche", vbInformation + vbOKOnly, "Erreur de recherche"
            Exit Sub
        End If
        LstResultat.Visible = True
        LstResultat.ColumnCount = 8
        LstResultat.ColumnWidths = "7cm" & ";" & "4cm" & ";" & "4cm" & ";" & "3cm" & ";" & "3cm" & ";" & "6cm" & ";" & "7cm" & ";" & "1,5cm"
'        LstResultat.List = TAB1()
    End If

        If I > 1 Then
            LstResultat.List = Application.Transpose(TAB1)
        Else
            LstResultat.AddItem TAB1(1, 1)
            For c = 2 To 8
                LstResultat.List(LstResultat.ListCount - 1, c - 1) = TAB1(c, 1)
            Next c
        End If
    
End Sub
 

scuba

XLDnaute Nouveau
Re : ListBox vers plusieurs TextBox

Re bonjour

Bebere, j'ai apprécié ton code optimisé.
Reste à supprimer cette vilaine ImputBox.

CHALET53, Table 1 est un tableau placé dans la feuille Table qui reçoit les données.
Est ce que j'y fais référence dans le code, certainement comme il faudrait.

Pourquoi supprimer un élément de la ListBox avec le bouton "Supprimer". Je pensait qu'il fallait supprimer l'élément de la
ListBox en même temps que sa suppression dans la base.
J'ai tout faux ou mon raisonnement tient la route?

Laeticia90, J'ai bien apprécié la recherche sur code postal et ville, intéressante si la liste est longue.
Si le champ de recherche sur le nom était intégré dans le même bloc que la recherche sur code postal et ville,
ça me paraîtrait plus cohérent. Qu'en penses-tu.

En tout cas, en un jour j'ai plus progressé qu'en 2 semaines de recherches.
Pour cela, soyez en remerciés
 

MADAGASCAR

XLDnaute Occasionnel
Re : ListBox vers plusieurs TextBox

Bonsoir Forum
Bonsoir a tous et a toutes
j'ai fais une recherche dans ce forum (LISTBOX) et j'ai trouve ce fichier.
merci a tous qui ont participe dans ce superbe sujet
j'ai presque pris une idee .. mais comme meme il me reste une petite question qui m'a fais fatigue ..
j'ai essaye de changer le nom de plage de recherche dans Feuil1 (Table) c a dire d'apres ce code (C8:J) ..j'ai reusi a fficher les noms dans la listbox mais si je fais un double clique sur n'importe quel nom les cordonnees de ce nom choisi ne s'affichent pas dans les textbox.. donc svp quelle est la partie dans ce code qui est responsable en cas de changement de ligne et de colonne
merci d'avance
cordialement
MADA
 

Pièces jointes

  • repertoire a essayer.xlsm
    31.2 KB · Affichages: 35
  • repertoire a essayer.xlsm
    31.2 KB · Affichages: 42
  • repertoire a essayer.xlsm
    31.2 KB · Affichages: 47
Dernière édition:

Statistiques des forums

Discussions
312 758
Messages
2 091 784
Membres
105 074
dernier inscrit
JPATOUNE