Combobox listé dans une listbox ?

cs_DPH91 Messages postés 10 Date d'inscription jeudi 18 janvier 2007 Statut Membre Dernière intervention 1 juin 2011 - 30 mai 2011 à 09:46
cs_DPH91 Messages postés 10 Date d'inscription jeudi 18 janvier 2007 Statut Membre Dernière intervention 1 juin 2011 - 1 juin 2011 à 07:43
Bonjour,

Je n'arrive pas à trouver le code manquant dans mon fichier ci-joint : Fichier tests.

J'ai une combox qui filtre les données, et les affiche dans une listbox.
Lors de la sélection de la listbox, il faudrait que les champs se remplissent de la ligne excel correspondante.
Actuellement, ce n'est pas la bonne ligne qui s'affiche dans les champs, et je ne trouve pas le code correspondant.

Une aide volontaire serait la bienvenue

Didier

4 réponses

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 137
31 mai 2011 à 09:27
Bonjour,
Tout d'abord ce n'est pas du VB6, mais du vba Excel.
Pour ajouter des données à la suite des autres, c'est simple. Il faut sélectionner la dernière ligne de saisie
Voici le code:

Private Sub Recherche_Change() 'au changement dans la combobox "Recherche"
Dim cel As Range 'déclare la variable cel (CELlule)

Me.CodeList.Clear 'vide la listbox "CodeList"
Find_derligne 'on sélectionne la dernière ligne de saisie
'boucle sur toutes les cellules éditées cel de la colonne A de l'onglet "Feuil1"
For Each cel In Sheets("Feuil1").Range("A2:A" & Sheets("Feuil1").Cells(Application.Rows.Count, 1).End(xlUp).Row)
    'condition : si la valeur de la cellule (convertie en texte) est égale à la valeur de la combobox "Recherche"
    If CStr(cel.Value) = Me.Recherche.Value Then
        Me.CodeList.AddItem cel.Value 'ajoute la valeur de la cellule dans la première colonne de la listbox (colonne 0)
        With Me.CodeList 'prend en compte la listbox "CodeList"
            .List(.ListCount - 1, 1) = cel.Offset(0, 1).Value 'ajoute la valeur de la cellule décalée d'une colonne dans la seconde colonne
            .List(.ListCount - 1, 2) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la troisième colonne
            .List(.ListCount - 1, 3) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la quatrième colonne
            .List(.ListCount - 1, 4) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la cinquième colonne
            .List(.ListCount - 1, 5) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la sixième colonne
            .List(.ListCount - 1, 6) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la septième colonne
            .List(.ListCount - 1, 7) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la huitième colonne
        End With 'fin de la prise en compte de la listbox "CodeList"
    End If 'fin de la condition
Next cel 'prochaine cellule cel de la boucle
End Sub
Private Sub Find_derligne()
Dim Derniereligne As Integer
 Sheets("Feuil1").Select
Derniereligne = Cells(Cells.Rows.Count, "A").End(xlUp).Row
 Rows(Derniereligne).Select
End Sub



@+Le Pivert
0
cs_DPH91 Messages postés 10 Date d'inscription jeudi 18 janvier 2007 Statut Membre Dernière intervention 1 juin 2011
31 mai 2011 à 10:14
Bonjour, et merci pour votre participation, mais ce n'est pas ce que je cherche exactement.

J'ai une combobox (Recherche) qui affiche dans la listbox (CodeList) les données filtrées du tableau Excel (sans doublon).

Private Sub Recherche_Change() 'au changement dans la combobox "Recherche"
Dim cel As Range 'déclare la variable cel (CELlule)
Me.CodeList.ColumnCount = 2
Me.CodeList.Clear 'vide la listbox "CodeList"
'Boucle sur toutes les cellules éditées cel de la colonne A de l'onglet "Sheet1"
For Each cel In Sheets("Sheet1").Range("A6:A" & Sheets("Sheet1").Cells(Application.Rows.Count, 1).End(xlUp).Row)
    'condition : si la valeur de la cellule (convertie en texte) est égale à la valeur de la combobox "Recherche"
    If CStr(cel.Value) = Me.Recherche.Value Then
        Me.CodeList.AddItem cel.Value 'ajoute la valeur de la cellule dans la première colonne de la listbox (colonne 0)
        With Me.CodeList 'prend en compte la listbox "CodeList"
            .List(.ListCount - 1, 1) = cel.Offset(0, 1).Value 'ajoute la valeur de la cellule décalée d'une colonne dans la seconde colonne
        End With 'fin de la prise en compte de la listbox "CodeList"
    End If 'fin de la condition
Next cel 'prochaine cellule cel de la boucle
End Sub


Lorsque je sélectionne une des lignes de la listbox (recherche), les champs Textbox se remplissent des données sélectionnées.

Lorsque je modifie un des textbox, je modifie alors les données de la ligne Excel correspondante. Ce que je souhaite, c'est lorsque une ligne est modifiée, que ce soit la ligne en question qui soit implémentée des données modifiées.

Cordialement

Didier
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 137
1 juin 2011 à 06:44
J'ai trouvé ceci avec la méthode Find pour rchercher le nom de la ligne à sélectionner

Dim nom
Private Sub CodeList_Click()
    Range("Feuil1!A2").Select
    ActiveCell.Offset(CodeList.ListIndex, 0).Select
ChercheInput
   '-- transfert Base de Données --> Formulaire
    Code = ActiveCell.Offset(0, 0).Value
    Etb = ActiveCell.Offset(0, 1).Value
    AUTRE1 = ActiveCell.Offset(0, 2).Value
    AUTRE2 = ActiveCell.Offset(0, 3).Value
    AUTRE3 = ActiveCell.Offset(0, 4).Value
    AUTRE4 = ActiveCell.Offset(0, 5).Value
    AUTRE5 = ActiveCell.Offset(0, 6).Value
    AUTRE6 = ActiveCell.Offset(0, 7).Value
    AUTRE7 = ActiveCell.Offset(0, 8).Value
End Sub
Private Sub Save_Click()
    If Recherche.Value = "" Then
        MsgBox "Veuillez effectuer une recherche avant de mettre à jour les données", vbInformation
        Recherche.SetFocus
    Else
        Range("Feuil1!A4").Select
        ActiveCell.Offset(Recherche.ListIndex, 0).Select
        ActiveCell.Offset(0, 0).Value = Code
        ActiveCell.Offset(0, 1).Value = Etb
        ActiveCell.Offset(0, 2).Value = AUTRE1
        ActiveCell.Offset(0, 3).Value = AUTRE2
        ActiveCell.Offset(0, 4).Value = AUTRE3
        ActiveCell.Offset(0, 5).Value = AUTRE4
        ActiveCell.Offset(0, 6).Value = AUTRE5
        ActiveCell.Offset(0, 7).Value = AUTRE6
        ActiveCell.Offset(0, 8).Value = AUTRE7
    End If
End Sub
Private Sub Update_Click()
    [A65000].End(xlUp).Offset(1, 0).Select
   '--- Transfert Formulaire dans BD
    ActiveCell.Offset(0, 0).Value = Me.Code
    ActiveCell.Offset(0, 1).Value = Me.Etb
    ActiveCell.Offset(0, 2).Value = Me.AUTRE1
    ActiveCell.Offset(0, 2).Value = Me.AUTRE2
    ActiveCell.Offset(0, 2).Value = Me.AUTRE3
    ActiveCell.Offset(0, 2).Value = Me.AUTRE4
    ActiveCell.Offset(0, 2).Value = Me.AUTRE5
    ActiveCell.Offset(0, 2).Value = Me.AUTRE6
    ActiveCell.Offset(0, 2).Value = Me.AUTRE7
End Sub
Private Sub UserForm_Initialize()
Dim i As Integer
For i = 1 To 11
    Me.Controls("Label" & i).ForeColor = RGB(227, 27, 35) 'Défini la couleur de la police des champs Label
Next
    Me.Save.ForeColor = RGB(227, 27, 35) 'Défini la couleur de la police du bouton valider
    Me.Update.ForeColor = RGB(227, 27, 35) 'Défini la couleur de la police du bouton mettre à jour
    Me.Recherche.List = SansDoublonsTrié(Range([A2], [A65000].End(xlUp))) 'Filtrer les codes sans doublons
End Sub
Private Sub Recherche_Change() 'au changement dans la combobox "Recherche"
Dim cel As Range 'déclare la variable cel (CELlule)
nom = Recherche.Value
ChercheCell
Me.CodeList.Clear 'vide la listbox "CodeList"
'boucle sur toutes les cellules éditées cel de la colonne A de l'onglet "Feuil1"
For Each cel In Sheets("Feuil1").Range("A2:A" & Sheets("Feuil1").Cells(Application.Rows.Count, 1).End(xlUp).Row)
    'condition : si la valeur de la cellule (convertie en texte) est égale à la valeur de la combobox "Recherche"
    If CStr(cel.Value) = Me.Recherche.Value Then
        Me.CodeList.AddItem cel.Value 'ajoute la valeur de la cellule dans la première colonne de la listbox (colonne 0)
        With Me.CodeList 'prend en compte la listbox "CodeList"
            .List(.ListCount - 1, 1) = cel.Offset(0, 1).Value 'ajoute la valeur de la cellule décalée d'une colonne dans la seconde colonne
            .List(.ListCount - 1, 2) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la troisième colonne
            .List(.ListCount - 1, 3) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la quatrième colonne
            .List(.ListCount - 1, 4) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la cinquième colonne
            .List(.ListCount - 1, 5) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la sixième colonne
            .List(.ListCount - 1, 6) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la septième colonne
            .List(.ListCount - 1, 7) = cel.Offset(0, 2).Value 'ajoute la valeur de la cellule décalée de deux colonnes dans la huitième colonne
        End With 'fin de la prise en compte de la listbox "CodeList"
    End If 'fin de la condition
Next cel 'prochaine cellule cel de la boucle
End Sub
'1- à partir d'une saisie dans une inputbox
Sub ChercheInput()
'à partir d'une saisie dans une inputbox, donc d'une chaîne,
'cette procédure permet à la méthode Find de réussir avec tous
'types de données (texte, nombres entiers et décimaux, dates)
'grâce au transtypage avec CDate des chaînes qui peuvent être
'lues comme des dates
Dim plage As Range, valeur

  Set plage = Range("A:A")
  valeur = InputBox("Valeur à chercher :")
  If valeur = "" Then Exit Sub
  If InStr(1, valeur, _
        Application.International(xlDateSeparator)) > 0 Then
    valeur = CDate(valeur)
  End If
  plage.Find(valeur).Select
  
End Sub 'fs

'2- à partir de la valeur d'une cellule
Sub ChercheCell()
'à partir de la valeur d'une cellule
'le passage de cette valeur avec la méthode Evaluate ([])
'permet à Find de réussir avec tous types de données (y compris les dates)
Dim plage As Range

  Set plage = Range("A:A")
  plage.Find([nom]).Select
  
End Sub


Tu l'adapteras suivant tes besoins


@+Le Pivert
0
cs_DPH91 Messages postés 10 Date d'inscription jeudi 18 janvier 2007 Statut Membre Dernière intervention 1 juin 2011
1 juin 2011 à 07:43
Merci beaucoup pour ta participation, cela me donne une première piste, je vais l'adapter.

Didier
0
Rejoignez-nous