XL 2016 Alimentation d'un fichier selon données sélectionnées via une ComboBox

A

Aldonanou

XLDnaute Junior
Bonjour,

Je dois réaliser une étude de fréquentation. J'ai préparé un formulaire que j'ai réussi à coder, à l'exception de la récupération des informations des comboBox. D'habitude j'utilise des listes déroulantes et c'est beaucoup plus simple.

Lorsque je valide (pour l'enregistrement dans l'onglet synthèse), les colonnes A à C se complètent correctement mais à partir de la colonne D jusqu'à E, c'est toujours la 1ère ligne des comboBox qui est sélectionnée. Je joins l'intégralité du code ainsi que le formulaire.

Il doit très certainement falloir rajouter une information aux lignes ci-dessous :

Sheets("Synthèse").Cells(Ligne, 4) = ListBox_categorie.List
Sheets("Synthèse").Cells(Ligne, 5) = ListBox_marche.List
Sheets("Synthèse").Cells(Ligne, 6) = ListBox_motif.List

VB: 
Private Sub UserForm_Initialize()


'   Date formulaire
    'TextDate.Value = DateValue(Now)
    TextDate.Value = Format(Now(), "dd mmm yyyy hh:mm:ss am/pm")

'   Numéro séquence
    Me.TextBoxNum.Value = Format((Application.WorksheetFunction.Max(Worksheets("Synthèse").Columns(1))) + 1, "000")
    
    
'   Ajout de la liste des agences
    liste_agence.AddItem "1"
    liste_agence.AddItem "2"
    liste_agence.AddItem "3"
    liste_agence.AddItem "4"
    liste_agence.AddItem "5"
    liste_agence.AddItem "6"
    liste_agence.AddItem "7"
    liste_agence.AddItem "8"
    liste_agence.AddItem "9"
    liste_agence.AddItem "10"
  
'   Ajout de la liste de la Catégorie
    ListBox_categorie.AddItem "Client"
    ListBox_categorie.AddItem "N'est pas client"
    ListBox_categorie.AddItem "Prospect"
    ListBox_categorie.AddItem "Autres"

    
'   Ajout de la liste du Marché
    ListBox_marche.AddItem "A"
    ListBox_marche.AddItem "B"
    ListBox_marche.AddItem "C"
    ListBox_marche.AddItem "D"
    ListBox_marche.AddItem "E"
    ListBox_marche.AddItem "Autres"
    
    
'   Ajout de la liste du Motif
    ListBox_motif.AddItem "Remise"
    ListBox_motif.AddItem "Retrait"
    ListBox_motif.AddItem "RDV"
    ListBox_motif.AddItem "Sollicite une information"
    ListBox_motif.AddItem "Prise de RDV"
    ListBox_motif.AddItem "Demande d'assistance"
    ListBox_motif.AddItem "Effectuer une réclamation"
    ListBox_motif.AddItem "Autres"
    

End Sub



Private Sub ajouter_Click()


    Dim Synthèse As String
    
    Sheets("Synthèse").Activate
    ActiveSheet.Visible = True
    ActiveSheet.Select
  
    Dim Response As Byte
    Dim Ligne As Integer: Ligne = 2

        
            While Sheets("Synthèse").Cells(Ligne, 3).Value <> ""
            Ligne = Ligne + 1
            Wend
            
            Sheets("Synthèse").Cells(Ligne, 1) = CDbl(TextBoxNum)
            Sheets("Synthèse").Cells(Ligne, 2) = CDate(TextDate)
            Sheets("Synthèse").Cells(Ligne, 3) = liste_agence
            Sheets("Synthèse").Cells(Ligne, 4) = ListBox_categorie.List
            Sheets("Synthèse").Cells(Ligne, 5) = ListBox_marche.List
            Sheets("Synthèse").Cells(Ligne, 6) = ListBox_motif.List
            
            While Sheets("Synthèse").Cells(Ligne, 2).Value <> ""
            Ligne = Ligne + 1
            Wend
            
          
            
'       Vide les données puis affiche l'UserForm
            Unload Me
            Application.DisplayAlerts = False
            ActiveWorkbook.Save

            
            Application.DisplayAlerts = True
            UserForm1.Show
          
  
   Sheets("Menu").Select
  
End Sub



Private Sub liste_agence_Change()

    Dim I As Integer

    'Boucle pour ajouter les 10 agences à la liste déroulante
    For I = 1 To 10
        liste_agence.AddItem Cells(1, I)
    Next

End Sub

Private Sub quitter_Click()
Unload Me
End Sub

Merci de l'aide qui pourra m'être apportée afin de résoudre ce dysfonctionnement.

Cordialement
 
Solution
A
Bonjour,

Voici la solution que j'ai trouvé en corrigeant les lignes :
Sheets("Synthèse").Cells(Ligne, 4) = ListBox_categorie.List(ListBox_categorie.ListIndex)
Sheets("Synthèse").Cells(Ligne, 5) = ListBox_marche.List(ListBox_marche.ListIndex)
Sheets("Synthèse").Cells(Ligne, 6) = ListBox_motif.List(ListBox_motif.ListIndex)

cela fonctionne.

Attention : la valeur MultiSelect de la ListBox doit être à 0-fmMultiSelectSingle sinon cela ne fonctionne pas.

Pour ceux que cela intéresse voici le code intégral.

VB: 
Private Sub UserForm_Initialize()


'   Date formulaire
    'TextDate.Value = DateValue(Now)
    TextDate.Value = Format(Now(), "dd mmm yyyy hh:mm:ss am/pm")

'   Numéro séquence...
Trier par date Trier par votes
Dranreb

Dranreb

XLDnaute Barbatruc
Bonjour.
Pourquoi ne prenez vous pas la propriété Text des ComboBox ?
On peut aussi prendre leur propriété Value. Je ne l'aime pas parce son nom suggère qu'elle pourait être numérique, alors que c'est toujours un Variant/String, tandis que la Text est directement le String.
 
Vote positif 0 Vote négatif
A

Aldonanou

XLDnaute Junior
Bonjour,

Voici la solution que j'ai trouvé en corrigeant les lignes :
Sheets("Synthèse").Cells(Ligne, 4) = ListBox_categorie.List(ListBox_categorie.ListIndex)
Sheets("Synthèse").Cells(Ligne, 5) = ListBox_marche.List(ListBox_marche.ListIndex)
Sheets("Synthèse").Cells(Ligne, 6) = ListBox_motif.List(ListBox_motif.ListIndex)

cela fonctionne.

Attention : la valeur MultiSelect de la ListBox doit être à 0-fmMultiSelectSingle sinon cela ne fonctionne pas.

Pour ceux que cela intéresse voici le code intégral.

VB: 
Private Sub UserForm_Initialize()


'   Date formulaire
    'TextDate.Value = DateValue(Now)
    TextDate.Value = Format(Now(), "dd mmm yyyy hh:mm:ss am/pm")

'   Numéro séquence
    Me.TextBoxNum.Value = Format((Application.WorksheetFunction.Max(Worksheets("Synthèse").Columns(1))) + 1, "000")
   
   
'   Ajout de la liste des agences
    liste_agence.AddItem "1"
    liste_agence.AddItem "2"
    liste_agence.AddItem "3"
    liste_agence.AddItem "4"
    liste_agence.AddItem "5"
    liste_agence.AddItem "6"
    liste_agence.AddItem "7"
    liste_agence.AddItem "8"
    liste_agence.AddItem "9"
    liste_agence.AddItem "10"
 
'   Ajout de la liste de la Catégorie
    ListBox_categorie.AddItem "Client"
    ListBox_categorie.AddItem "N'est pas client"
    ListBox_categorie.AddItem "Prospect"
    ListBox_categorie.AddItem "Autres"

   
'   Ajout de la liste du Marché
    ListBox_marche.AddItem "A"
    ListBox_marche.AddItem "B"
    ListBox_marche.AddItem "C"
    ListBox_marche.AddItem "D"
    ListBox_marche.AddItem "E"
    ListBox_marche.AddItem "Autres"
   
   
'   Ajout de la liste du Motif
    ListBox_motif.AddItem "Remise"
    ListBox_motif.AddItem "Retrait"
    ListBox_motif.AddItem "RDV"
    ListBox_motif.AddItem "Sollicite une information"
    ListBox_motif.AddItem "Prise de RDV"
    ListBox_motif.AddItem "Demande d'assistance"
    ListBox_motif.AddItem "Effectuer une réclamation"
    ListBox_motif.AddItem "Autres"
   

End Sub


Private Sub ajouter_Click()

'   Coloration des Labels en noir (&H80000012 = couleur de base de la propriété ForeColor)
'   Si les informationsne sont pas toutes sélectionnées
    Label1.ForeColor = &H80000012
    LabelCategorie.ForeColor = &H80000012
    LabelMarche.ForeColor = &H80000012
    LabelMotif.ForeColor = &H80000012
   
'   Contrôles des champs
    If liste_agence = "" Then ' si pas d'agence
        Label1.ForeColor = RGB(255, 0, 0)
        intpout = MsgBox("Information à sélectionner", vbInformation, "")
    ElseIf ListBox_categorie.ListIndex = -1 Then 'Si pas de catégorie
        LabelCategorie.ForeColor = RGB(255, 0, 0)
        intpout = MsgBox("Information à sélectionner", vbInformation, "")
    ElseIf ListBox_marche.ListIndex = -1 Then 'Si pas de marché
        LabelMarche.ForeColor = RGB(255, 0, 0)
        intpout = MsgBox("Information à sélectionner", vbInformation, "")
    ElseIf ListBox_motif.ListIndex = -1 Then 'Si pas de motif
        LabelMotif.ForeColor = RGB(255, 0, 0)
        intpout = MsgBox("Information à sélectionner", vbInformation, "")
   
    Else


    Dim Synthèse As String
   
    Sheets("Synthèse").Activate
    ActiveSheet.Visible = True
    ActiveSheet.Select
    ActiveSheet.Unprotect Password:=""
   
'   Test msgbox pour confirmations des sélections
    'If ListBox_categorie.ListIndex = -1 Then Exit Sub
    'MsgBox ListBox_categorie.List(ListBox_categorie.ListIndex)
   
    'If ListBox_marche.ListIndex = -1 Then Exit Sub
    'MsgBox ListBox_marche.List(ListBox_marche.ListIndex)
   
    'If ListBox_motif.ListIndex = -1 Then Exit Sub
    'MsgBox ListBox_motif.List(ListBox_motif.ListIndex)
 
 
'   Message de confirmation de la saisie
    Dim réponse As Integer
       
        réponse = MsgBox("Date : " & TextDate + vbNewLine + vbNewLine + _
            ListBox_categorie.List(ListBox_categorie.ListIndex) + vbNewLine + _
            ListBox_marche.List(ListBox_marche.ListIndex) + vbNewLine + _
            ListBox_motif.List(ListBox_motif.ListIndex) + vbNewLine + vbNewLine + _
            "Voulez-vous confirmer ?", vbQuestion + vbYesNo, "Confirmation")

'   Si Oui
        Select Case réponse
            Case vbYes
            réponse = MsgBox("Nouvelle visite enregistrée avec succès !", , "Visite ajoutée")

    Dim Response As Byte
    Dim Ligne As Integer: Ligne = 2

       
            While Sheets("Synthèse").Cells(Ligne, 3).Value <> ""
            Ligne = Ligne + 1
            Wend
           
            Sheets("Synthèse").Cells(Ligne, 1) = CDbl(TextBoxNum)
            Sheets("Synthèse").Cells(Ligne, 2) = CDate(TextDate)
            Sheets("Synthèse").Cells(Ligne, 3) = liste_agence
            Sheets("Synthèse").Cells(Ligne, 4) = ListBox_categorie.List(ListBox_categorie.ListIndex)
            Sheets("Synthèse").Cells(Ligne, 5) = ListBox_marche.List(ListBox_marche.ListIndex)
            Sheets("Synthèse").Cells(Ligne, 6) = ListBox_motif.List(ListBox_motif.ListIndex)
           
            While Sheets("Synthèse").Cells(Ligne, 2).Value <> ""
            Ligne = Ligne + 1
            Wend
           
'   Si Non
            Case vbNo
            réponse = MsgBox("Nouvelle visite annulée avec succès !", , "Visite annulée")
       
        End Select

        Application.ScreenUpdating = True
        Application.Calculation = xlAutomatic
         
           
'       Vide les données puis affiche l'UserForm
            Unload Me
            Application.DisplayAlerts = False
            ActiveWorkbook.Save

           
            Application.DisplayAlerts = True
            UserForm1.Show
         
End If
 
   Sheets("Menu").Select
 
End Sub

Private Sub liste_agence_Change()

    Dim I As Integer

    'Boucle pour ajouter les 10 agences à la liste déroulante
    For I = 1 To 10
        liste_agence.AddItem Cells(1, I)
    Next

End Sub

Private Sub quitter_Click()
Unload Me
End Sub

Merci à XLDnaute Junior pour avoir suggérer une solution.
 

Pièces jointes

  • Etude de fréquentation.xlsm
    36 KB · Affichages: 6
Vote positif 0 Vote négatif
Solution

Discussions similaires

N
  • Résolu(e)
Microsoft 365 Remplir une ComboBox à 3 colonnes avec les données d'un TS
4 5 6
Réponses
78
Affichages
1 K
Dudu2
Dudu2
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
366
Chaton77
Chaton77
S
  • Question
XL 2019 Remplir une combobox avec une ligne
2
Réponses
17
Affichages
1 K
fanch55
fanch55
N
  • Résolu(e)
Microsoft 365 Transfère de données d'un Userform vers un tableau structuré d'une feuille de calcul
Réponses
4
Affichages
176
NONO14
N
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
1 K
Dranreb
Dranreb
T
  • Résolu(e)
Microsoft 365 filtre sur un tabstrip depuis un combobox
2
Réponses
27
Affichages
2 K
troki74
T
tactic6
  • Question
XL 2016 Aide pour userform (sujet clos)
Réponses
8
Affichages
420
tactic6
tactic6
Messan
  • Résolu(e)
XL 2019 Organiser les données dans listbox
Réponses
2
Affichages
652
Messan
Messan
C
  • Question
Autres bug sur une procédure avec textbox contenant un code barre
2
Réponses
15
Affichages
1 K
TooFatBoy
TooFatBoy
I
  • Résolu(e)
XL 2019 Supprimer une ligne d'une base de données une fois qu'elle est transférée sur une autre feuille
Réponses
8
Affichages
576
Isabellisa
I

Membres actuellement en ligne

4 membres et 46 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 729
Messages
2 112 268
Membres
111 481
dernier inscrit
zrk