Microsoft 365 Combobox et liste déroulante liées vba

[Bizarre]

Bonjour ;

Actuellement je travaille sur un formulaire appelé « frmajout_dans_bdd » la combo-box secteur (Combo Boxsecteur) se charge avec une liste déroulante et la combo-box code (comboboxcode) se remplit en fonction du choix de combo-box secteur. Je voudrais que si je rentre un nombre inexistant dans (comboboxcode) celui-ci se rajoute tout seul dans la liste correspondante, j’espère que cela et possible et surtout comment faire cela. Merci de bien vouloir m’aider. Je joins le fichier en question

 

[Robert]

Bonjour Bizarre, bonjour le forum,

J'ai modifié cette partie du code et supprimé la propriété RowSource de la combobox comboboxcode.

Private TB As ListObject 'déclare la variable TB (Tableau Structuré)
Private PL As Range 'déclare la variable PL (PLage)

'Procédure permettant d'initialiser le formulaire au démarrage
Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm

Application.ScreenUpdating = False
Unload frmpoire
Set TB = Sheets("Listederoulante").ListObjects("tblsecteur") 'définit la tableau structuré TB
Set PL = TB.DataBodyRange 'définit la plage PL
Me.ComboBoxsecteur.List = Application.Transpose(TB.HeaderRowRange) 'alimente la combobox [ComboBoxsecteur]
Application.ScreenUpdating = True
End Sub

'Procédure permettant de remplir la combobox en fonction de comboboxsecteur
Private Sub Comboboxsecteur_Change() 'au changement dans la combobox [Comboboxsecteur]
comboboxcode.Clear 'vide la combobox [comboboxcode]
'alimente la combobox [comboboxcode] en fonction de la valeur de la combobox [ComboBoxsecteur]
Me.comboboxcode.List = PL.Columns(Me.ComboBoxsecteur.ListIndex + 1).Value
End Sub

Private Sub comboboxcode_AfterUpdate() 'après la mise à jour de la combobox [comboboxcode]
Dim CEL As Range 'déclare la variable CEL (CELlule)

If Me.comboboxcode.ListIndex = -1 Then 'si la valeur tapé n'appratient pas à la liste
    If MsgBox("Voulez-vous ajouter ce code : " & Me.comboboxcode.Value & ", dans la liste " & Me.ComboBoxsecteur.Value & " ?", vbYesNo) = vbYes Then 'condition : si "Oui" au message
        Set CEL = PL(1, Me.ComboBoxsecteur.ListIndex + 1).End(xlDown).Offset(1, 0) 'définit la cellule CEL
        CEL.Value = Me.comboboxcode.Value 'renvoie la valeur éditée dans la cellue CEL
    End If
End If
End Sub

 

[Bizarre]

Bonsoir ;

Voilà le code qui me pose problème sur le fichier exemple v1 tout fonctionne parfaitement et j’ai donc recopier le code en changeant seulement le nom du formulaire et en enlevant la protection de la feuille et voila l’erreur afficher

Private TB As ListObject 'déclare la variable TB (Tableau Structuré)
Private PL As Range 'déclare la variable PL (PLage)

'Procédure permettant d'initialiser le formulaire au démarrage
Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm
Application.ScreenUpdating = False
Unload Formulaire_Ajout_Donnée
Set TB = Sheets("Listederoulante").ListObjects("tblsecteur") 'définit la tableau structuré TB
Set PL = TB.DataBodyRange 'définit la plage PL
Me.ComboBoxsecteur.List = Application.Transpose(TB.HeaderRowRange) 'alimente la combobox [ComboBoxsecteur]
Application.ScreenUpdating = True

Sheets("Basededonnée").Activate
End Sub
'Procédure permettant de remplir la combobox en fonction de comboboxsecteur
Private Sub Comboboxsecteur_Change()
ActiveSheet.Unprotect

'au changement dans la combobox [Comboboxsecteur]
comboboxcode.Clear 'vide la combobox [comboboxcode]
'alimente la combobox [comboboxcode] en fonction de la valeur de la combobox [ComboBoxsecteur]
Me.comboboxcode.List = PL.Columns(Me.ComboBoxsecteur.ListIndex + 1).Value

ActiveSheet.Protect
End Sub

Private Sub comboboxcode_AfterUpdate() 'après la mise à jour de la combobox [comboboxcode]
Dim CEL As Range 'déclare la variable CEL (CELlule)
ActiveSheet.Unprotect


If Me.comboboxcode.ListIndex = -1 Then 'si la valeur tapé n'appratient pas à la liste
    If MsgBox("Voulez-vous ajouter ce code : " & Me.comboboxcode.Value & ", dans la liste " & Me.ComboBoxsecteur.Value & " ?", vbYesNo) = vbYes Then 'condition : si "Oui" au message
        Set CEL = PL(1, Me.ComboBoxsecteur.ListIndex + 1).End(xlDown).Offset(1, 0) 'définit la cellule CEL
        CEL.Value = Me.comboboxcode.Value 'renvoie la valeur éditée dans la cellue CEL
    End If
End If
ActiveSheet.Protect
End Sub

 

[JM27]

Bonsoir
Il aurait été bien de répondre à ce fil avant de poser une autre question, comme cela on n'aura pas l'impression de travailler pour rien
https://www.excel-downloads.com/threads/combobox-en-cascade.20063733/#post-20481907

 

[Robert]

Bonjour le fil, bonjour le forum,

Connaître l'erreur c'est bien mais quand elle arrive, la ligne qui la provoque est surlignée de jaune. Quelle est cette ligne ?

 

[Valtrase]

Salut,
ici il te manque l'assignation

TB = Se Sheets("Listederoulante").ListObjects("tblsecteur")

changer en

Set TB = Sheets("Listederoulante").ListObjects("tblsecteur").ListObject

Sinon Robert à raison sur quelle ligne tu as l'erreur....

 

[Bizarre]

Bonsoir
Il aurait été bien de répondre à ce fil avant de poser une autre question, comme cela on n'aura pas l'impression de travailler pour rien
https://www.excel-downloads.com/threads/combobox-en-cascade.20063733/#post-20481907

Bonsoir JM27 ; vous aviez tout à fait raison de me dire qu’effectivement la moindre des choses aurait été de vous répondre au sujet de votre travail. Quand j’ai ouvert le fichier exemple 6 fourni par vos soins avec le code pour les listes déroulantes je n’ai pas réussi à le faire fonctionner. Du coup après votre message de dimanche soir je me suis replongé dans ce fichier et là ça marche, en fait j’essayais de modifier le contenu de label1 pour changer le code alors qu’il fallait simplement valider pour avoir le code. Du coup maintenant j’ai réussi à adapter votre code à mon fichier et ça marche. Dans votre message de mercredi vous avez aussi mis ce message

Nota : si tu mets en place un tableau structuré dans ta feuille liste, cela ne marchera pas (dans ce cas).

Pour essayer j’ai quand même mis les données de la feuille « listederoulante » sous forme de tableau et apparemment cela fonctionne. Je dis cela juste à titre d’information. Je joins le fichier en question, la feuille liste et devenue « Listederoulante » Encore toutes mes excuses pour le laisser aller au sujet de votre travail. Je pense ouvrir une nouvelle discussion pour empêcher les doublons dans l’ensemble du tableau

Tableau_code _en _service.

Merci de votre patience

 

[Bizarre]

Bonjour le fil, bonjour le forum,

Connaître l'erreur c'est bien mais quand elle arrive, la ligne qui la provoque est surlignée de jaune. Quelle est cette ligne ?

Bonjour le fil, bonjour le forum,

Connaître l'erreur c'est bien mais quand elle arrive, la ligne qui la provoque est surlignée de jaune. Quelle est cette ligne ?

Bonsoir Robert ;

Merci de vous occuper encore de mon problème, JM27 à trouver une solution qui me convient et que j’ai pu adapter à mon fichier je tiens quand même à vous remercier pour le temps que vous avez consacré à mon problème et merci également à Valtrase et à bientôt sur le forum pour un autre problème.

Je mets le code en question

Private Sub UserForm_Initialize()
     Dim cell As Range
     With Sheets("Listederoulante")
        For Each cell In .Range("A2:A" & .Range("A100").End(xlUp).Row)
            Me.ComboBoxsecteur.AddItem (cell)
        Next
    End With
    Label4 = Date
   Sheets("Basededonnée").Activate
End Sub

Private Sub ComboBoxsecteur_Change()
    Me.LabelCode.Caption = Application.Max(Range(Sheets("Listederoulante").Cells(2, Me.ComboBoxsecteur.ListIndex + 3), Sheets("Listederoulante").Cells(Sheets("Listederoulante").Cells(100, Me.ComboBoxsecteur.ListIndex + 3).End(xlUp).Row, Me.ComboBoxsecteur.ListIndex + 3)))
End Sub

Private Sub btnajouter_Click()
    Dim DerligneBDD As Long
    Dim DerligneListe As Long
    DerligneBasededonnée = Sheets("Basededonnée").Range("a65536").End(xlUp).Row + 1
    Sheets("Basededonnée").Cells(DerligneBasededonnée, 1) = Me.ComboBoxsecteur
    Sheets("Basededonnée").Cells(DerligneBasededonnée, 2) = CLng(Me.LabelCode.Caption) + 1
    Sheets("Basededonnée").Cells(DerligneBasededonnée, 3) = Me.cbocommune
    Sheets("Basededonnée").Cells(DerligneBasededonnée, 4) = Me.cbosyndicat
    Sheets("Basededonnée").Cells(DerligneBasededonnée, 5) = Me.TextBox_reservoir

    DerligneListe = Sheets("Listederoulante").Cells(1, Me.ComboBoxsecteur.ListIndex + 3).End(xlDown).Row + 1
    Sheets("Listederoulante").Cells(DerligneListe, Me.ComboBoxsecteur.ListIndex + 3) = CLng(Me.LabelCode.Caption) + 1
    MsgBox " données transférées dans la base de données"
    Unload Me
    frmajoutdonnée.Show
End Sub

 

[Bizarre]

Salut,
ici il te manque l'assignation

TB = Se Sheets("Listederoulante").ListObjects("tblsecteur")

changer en

Set TB = Sheets("Listederoulante").ListObjects("tblsecteur").ListObject

Sinon Robert à raison sur quelle ligne tu as l'erreur....

Merci de prendre mon problème en compte, une solution a été trouvé par JM27

 

[JM27]

bonsoir
pour empêcher les doublons dans Listedéroulante

Private Sub ComboBoxsecteur_Change()
    Me.LabelCode.Caption = Application.Max(Sheets("Listederoulante").Range("C2:G100"))
End Sub

 

[Bizarre]

Bonsoir JM27

Je viens de tester votre code et il laisse passer les doublons, je m’explique. Dans Comboboxsecteur je fais un choix dans la liste déroulante et en fonction de ce choix il m’affiche le chiffre correspondant à cette référence contenue dans le tableau (C2 : G2) de la feuille « Listederoulante ».

Exemple : Si je mets Sect BB dans comboboxSecteur il va afficher 1 dans la TextBoxCode et ajouter 1 en rangeant dans le tableau « Tableau_code_en_service » de la feuille Listederoulante, de fait j’aurais 2 fois le chiffre 2 dans mon tableau. Existe t’il une solution pour qu’avant de ranger dans le tableau il regarde si ce chiffre existe déjà et si oui prenne le suivant. Afin de faciliter la compréhension je joins le fichier. Merci de votre aide

 

[JM27]

Bonsoir
Il y a plus rien dans ce fichier de ce que j'ai écrit!

 

[Bizarre]

Bonsoir;
je viens de tester avec votre fichier original, je trouve le même problème sur les doublons. Je joins votre fichier au cas où c'est moi qui déconne un peu ..

 

[JM27]

Bonsoir

 

[Bizarre]

Re
Je viens de tester c'est ok je tente de l'adapter à mon fichier je vous tiens au courant