Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
Microsoft 365Combobox ajouter si n'existe pas dans Liste
Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
Bonjour à tous,
Je me retrouve face à un problème avec une combobox(exemple CbFournisseur1), je souhaiterai lors de l'entrée d'une valeur non présente dans le TB TbFournisseur, l'ajouter à ce tableau, j'ai donc mis ce code
VB:
'**************************************************************************************
'TEST SI LA SOCIETE EXISTE DEJA
'**************************************************************************************
'nom de la feuille
Set ws = ThisWorkbook.Sheets("Données")
' nom du tableau structuré
Set TbFourn = ws.ListObjects("TbFournisseur")
' Récupérez les valeurs des TextBox du UserForm
valeurA = UsfAchats.CbFournisseur1.Value
' Réinitialiser les indicateurs
trouveA = False
' Recherche de la valeur A dans la colonne du tableau structuré correspondant à "cbfournisseur1"
If ws.ListObjects("TbFournisseur").ListRows.Count <> 0 Then
For Each cell In TbFourn.ListColumns(1).DataBodyRange
If cell.Value = valeurA Then
trouveA = True
Exit For
End If
Next cell
End If
' Vérifier si la valeur ont été trouvée
If trouveA Then
Else
With ws.ListObjects("TbFournisseur")
Dim W
' On constitue la liste de données à Ajouter à la liste
W = Array(CbFournisseur1)
.ListRows.Add.Range.Cells(1).Resize(, 1) = W ' On ajoute la ligne à la base
End With
End If
End Sub
dans l'évènement Afterupdate de ma combobox (code déjà utilisé à maintes reprises sans problème), mais cette fois il plante au moment d'ajouter la ligne et me sors carrément du fichier, il doit y avoir une incohérence, mais je ne la vois pas.
Auriez-vous une petite idée du pourquoi?
Merci beaucoup de votre aide!
Eric
Salut,
L'erreur se produit car les comboboxs 1 à 5 sont liés par des rowsource à la table des fournisseurs, ce qui interdit la mise à jour de la table
Il faut donc rompre ce lien, mettre à jour la table et rétablir les liens .
VB:
Private Sub CbFournisseur1_Enter()
CbFournisseur1.DropDown
End Sub
Private Sub CbFournisseur1_AfterUpdate()
If CbFournisseur1 = "" Then Exit Sub
With ThisWorkbook.Sheets("Données").[TbFournisseur[Fournisseur]] 'nom de la feuille
Set f = .Find(Me.CbFournisseur1.Value, , , xlWhole)
If f Is Nothing Then ' Le fournisseur n'existe pas, on doit l'ajouter
' Rupture des liens avec la table des fournisseurs qu'on doit mettre à jour
For i = 1 To 5...
Merci pour ta réponse, quand tu dis qu'il fonctionne, cela veut dire que si tu inscris un fournisseur qui n'est pas dans la liste, il s'ajoute bien à la liste des fournisseurs? Bizarre, sur 365 ça plante...
Merci pour ta réponse, quand tu dis qu'il fonctionne, cela veut dire que si tu inscris un fournisseur qui n'est pas dans la liste, il s'ajoute bien à la liste des fournisseurs? Bizarre, sur 365 ça plante...
juste ajout d'un fournisseur avec la première combobox et ça l'ajoute au tableau.
Le nouveau fournisseur ne s'ajoute uniquement qu'avec la 1ère combobox, pas avec les autres.
Salut,
L'erreur se produit car les comboboxs 1 à 5 sont liés par des rowsource à la table des fournisseurs, ce qui interdit la mise à jour de la table
Il faut donc rompre ce lien, mettre à jour la table et rétablir les liens .
VB:
Private Sub CbFournisseur1_Enter()
CbFournisseur1.DropDown
End Sub
Private Sub CbFournisseur1_AfterUpdate()
If CbFournisseur1 = "" Then Exit Sub
With ThisWorkbook.Sheets("Données").[TbFournisseur[Fournisseur]] 'nom de la feuille
Set f = .Find(Me.CbFournisseur1.Value, , , xlWhole)
If f Is Nothing Then ' Le fournisseur n'existe pas, on doit l'ajouter
' Rupture des liens avec la table des fournisseurs qu'on doit mettre à jour
For i = 1 To 5: Me.Controls("CbFournisseur" & i).RowSource = "": Next
Idx = .ListObject.ListRows.Add().Index
.Rows(Idx) = Me.CbFournisseur1.Value
' Rétablissement des liens avec la table des fournisseurs
For i = 1 To 5: Me.Controls("CbFournisseur" & i).RowSource = .ListObject.Name: Next
End If
End With
End Sub
dans l'évènement Afterupdate de ma combobox (code déjà utilisé à maintes reprises sans problème), mais cette fois il plante au moment d'ajouter la ligne
mais tu ne nous expliques pas les circonstances du plantage. Etant donné que cela fonctionner.
Je reconnais une adaptation du code de feu Jacques Boisgontier.
Tu n'as pas déclaré toutes tes variables, ce qui pourrait te jouer des tours.
Je t'avais dit que sur Excel 2010, lorsqu'il s'agit uniquement de la 1ère combobox, le code ne plante pas et ajoute le nouveau fournisseur.
Mais ce n'est pas le cas pour les autres comboboxs.
Personnellement, je trouve que c'est une très mauvaise idée de rajouter le nouveau fournisseur avant la validation via le bouton.
En effet, tu utilises l'évènement "CbFournisseur1_AfterUpdate".
Chez-moi le code plante lorsque je clique dans la listbox. Que veux-tu faire exactement en utilisant ce contrôle?
Nous sommes prêt à t'aider, mais il faudrait nous expliquer les tenants et aboutissants de ton projet.
Salut,
L'erreur se produit car les comboboxs 1 à 5 sont liés par des rowsource à la table des fournisseurs, ce qui interdit la mise à jour de la table
Il faut donc rompre ce lien, mettre à jour la table et rétablir les liens .
VB:
Private Sub CbFournisseur1_Enter()
CbFournisseur1.DropDown
End Sub
Private Sub CbFournisseur1_AfterUpdate()
If CbFournisseur1 = "" Then Exit Sub
With ThisWorkbook.Sheets("Données").[TbFournisseur[Fournisseur]] 'nom de la feuille
Set f = .Find(Me.CbFournisseur1.Value, , , xlWhole)
If f Is Nothing Then ' Le fournisseur n'existe pas, on doit l'ajouter
' Rupture des liens avec la table des fournisseurs qu'on doit mettre à jour
For i = 1 To 5: Me.Controls("CbFournisseur" & i).RowSource = "": Next
Idx = .ListObject.ListRows.Add().Index
.Rows(Idx) = Me.CbFournisseur1.Value
' Rétablissement des liens avec la table des fournisseurs
For i = 1 To 5: Me.Controls("CbFournisseur" & i).RowSource = .ListObject.Name: Next
End If
End With
End Sub
Comme déjà dit, sur excel 2010 pas de problème.
J'attends que notre ami, nous dise que faut-il faire lorsqu'on saisit un nouveau fournisseur dans les autres comboboxs.
On l'ajoute au tableau ou non?
Là, on utilise uniquement l'évènement afterupdate d'une seule combobox.
Bonjour à tous,
Petites questions, pourquoi faire difficile quand on peut faire simple ? Dans ces lignes :
VB:
W = Array(CbFournisseur1)
.ListRows.Add.Range.Cells(1).Resize(, 1) = W ' On ajoute la ligne à la base
Le tableau Fournisseurs ne comporte qu'une colonne alors pourquoi faire des Resize et autres Array() ?
Pourquoi laisser libre la condition vrai dans :
Code:
If Found Then
Else
With ws.ListObjects("TbFournisseur")
Dim W
'...
'...
Ne serait-il pas plus judicieux de passer par un Factory Pattern pour initialiser les Tableaux et colonnes des tableaux ? Cela éviterait de se peller tout le code si changement de noms.
Mettre Option Explicit en tête de module évitera pas mal de problèmes par la suite.
L'option Compare Text n'est valable que lors de l'utilisation de l'opérateur LIKE, l'opérateur "=" recherche une correspondance exacte, si vous voulez omettre la casse alors il faut lui préférer StrComp.
L'utilisation de RowSource pour les listes et listes déroulantes ne peut que poser des problèmes.
Dans ces lignes :
VB:
Set rng = f.Range("A2:F" & f.[a1000000].End(xlUp).Row)
vous pouvez utiliser les avantages des tableaux structurés.
La logique du formulaire est à revoir, vous avez un bouton enregistrer et un bouton Editer, alors que vous voulez que les lignes s'ajoutent sur un AfterUpdate.
Il est conseillé de travailler avec un ID pour les tableaux, l'ajout de lignes avec un nom identique, et une adresse différente par exemple doit-être possible.
Donc si l'on considère un module Factory de la sorte :
VB:
'@Folder "System"
Option Explicit
Public Type FournisseurColumns
ID As String
Nom As String
Adresse As String
Ville As String
End Type
Public Type ArticleColumns
Reference As String
Designation As String
PrixUnitaire As String
End Type
'@Description "Retourne un objet ListObject s'il existe sinon retourne Nothing"
Private Function getListObject( _
ByVal ListName As String, _
Optional ByVal Workbook As Excel.Workbook _
) As Excel.ListObject
Dim localWorkbook As Excel.Workbook
Set localWorkbook = Workbook
If localWorkbook Is Nothing Then Set localWorkbook = ThisWorkbook
With localWorkbook
Do
Dim CounterSheets As Integer
CounterSheets = CounterSheets + 1
Dim CounterListObjects As Integer: CounterListObjects = 0
With .Worksheets(CounterSheets)
Do While CounterListObjects < .ListObjects.Count And getListObject Is Nothing
CounterListObjects = CounterListObjects + 1
If StrComp(ListName, .ListObjects(CounterListObjects).Name, vbTextCompare) = 0 Then Set getListObject = .ListObjects(CounterListObjects)
Loop
End With
Loop While CounterSheets < .Worksheets.Count And getListObject Is Nothing
End With
End Function
'@Description "Initialise le tableau des données des fournisseurs."
Public Function InitTabFournisseurs( _
Optional ByVal Reset As Boolean _
) As ListObject
Static item As ListObject
If item Is Nothing Or Reset Then
Set item = getListObject("TbFournisseur")
End If
Set InitTabFournisseurs = item
End Function
'@Description "Initialise le tableau des données de base."
Public Function InitTabAchats( _
Optional ByVal Reset As Boolean _
) As ListObject
Static item As ListObject
If item Is Nothing Or Reset Then
Set item = getListObject("TbAchats")
End If
Set InitTabAchats = item
End Function
'@Description "Initialise le tableau des comptes."
Public Function InitTabComptes( _
Optional ByVal Reset As Boolean _
) As ListObject
Static item As ListObject
If item Is Nothing Or Reset Then
Set item = getListObject("TbComptes")
End If
Set InitTabComptes = item
End Function
'@Description "Retourne les noms de colonnes pour le tableau TbFournisseur."
Public Function GetFournisseurColumnNames( _
) As FournisseurColumns
Dim Columns As FournisseurColumns
With Columns
.ID = "ID"
.Nom = "Nom"
.Adresse = "Adresse"
.Ville = "Ville"
End With
GetFournisseurColumnNames = Columns
End Function
La méthode AfterUpdate pourait ressembler à ceci :
VB:
Private Sub CbFournisseur1_AfterUpdate()
Dim lstO As Excel.ListObject
Set lstO = Factory.InitTabFournisseurs
If Not lstO Is Nothing Then
' // Initialisation des entêtes de colonnes du tableau fournisseurs
Dim ColumnsNames As Factory.FournisseurColumns
ColumnsNames = Factory.GetFournisseurColumnNames
With lstO
If .ListRows.Count > 0 Then
Dim Found As Boolean
Dim itemRange As Excel.Range
For Each itemRange In .ListColumns(ColumnsNames.Nom).DataBodyRange
If StrComp(itemRange.Value, Me.CbFournisseur1.Value) = 0 Then Found = True: Exit For
Next itemRange
End If
'Todo "La logique du formulaire est à revoir
If Not Found Then
Dim newRow As Excel.ListRow
Set newRow = .ListRows.Add
With newRow
'.Range(1).Value = CbFournisseur1.Value ' // Affectation directe
.Range(.Parent.ListColumns(ColumnsNames.ID).Index).Value = GetMaxId(lstO, ColumnsNames.ID) ' // Affectation par le nom de colonne
.Range(.Parent.ListColumns(ColumnsNames.Nom).Index).Value = CbFournisseur1.Text ' // Affectation par le nom de colonne
' .Range(.Parent.ListColumns(ColumnsNames.Adresse).Index).Value = vbNullString
' .Range(.Parent.ListColumns(ColumnsNames.Ville).Index).Value = vbNullString
End With
End If
End With
End If
End Sub
Avec la fonction GetMaxId c'est mieux...
VB:
Private Function GetMaxId( _
ByVal Table As Excel.ListObject, _
Optional ByVal Column As String = "ID", _
Optional ByVal Increment As Boolean = True _
) As Long
If Not Table Is Nothing Then
With Table
If .ListRows.Count = 0 Then
GetMaxId = 1
Else
GetMaxId = Application.WorksheetFunction.Max(Table.ListColumns(Column).DataBodyRange) + IIf(Increment, 1, 0)
End If
End With
End If
End Function
Salut,
L'erreur se produit car les comboboxs 1 à 5 sont liés par des rowsource à la table des fournisseurs, ce qui interdit la mise à jour de la table
Il faut donc rompre ce lien, mettre à jour la table et rétablir les liens .
VB:
Private Sub CbFournisseur1_Enter()
CbFournisseur1.DropDown
End Sub
Private Sub CbFournisseur1_AfterUpdate()
If CbFournisseur1 = "" Then Exit Sub
With ThisWorkbook.Sheets("Données").[TbFournisseur[Fournisseur]] 'nom de la feuille
Set f = .Find(Me.CbFournisseur1.Value, , , xlWhole)
If f Is Nothing Then ' Le fournisseur n'existe pas, on doit l'ajouter
' Rupture des liens avec la table des fournisseurs qu'on doit mettre à jour
For i = 1 To 5: Me.Controls("CbFournisseur" & i).RowSource = "": Next
Idx = .ListObject.ListRows.Add().Index
.Rows(Idx) = Me.CbFournisseur1.Value
' Rétablissement des liens avec la table des fournisseurs
For i = 1 To 5: Me.Controls("CbFournisseur" & i).RowSource = .ListObject.Name: Next
End If
End With
End Sub
Bonjour Fanch55,
Merci beaucoup pour la réponse et les explications. Si je comprends bien le fait d'ajouter un nom à la liste qui est déjà liée à la Combobox fait planter. Alors là!!!
Je me coucherais une nouvelle fois un peu moins bête ce soir.
Merci à tous pour votre aide et bonne soirée.
mais tu ne nous expliques pas les circonstances du plantage. Etant donné que cela fonctionner.
Je reconnais une adaptation du code de feu Jacques Boisgontier.
Tu n'as pas déclaré toutes tes variables, ce qui pourrait te jouer des tours.
Je t'avais dit que sur Excel 2010, lorsqu'il s'agit uniquement de la 1ère combobox, le code ne plante pas et ajoute le nouveau fournisseur.
Mais ce n'est pas le cas pour les autres comboboxs.
Personnellement, je trouve que c'est une très mauvaise idée de rajouter le nouveau fournisseur avant la validation via le bouton.
En effet, tu utilises l'évènement "CbFournisseur1_AfterUpdate".
Chez-moi le code plante lorsque je clique dans la listbox. Que veux-tu faire exactement en utilisant ce contrôle?
Nous sommes prêt à t'aider, mais il faudrait nous expliquer les tenants et aboutissants de ton projet.
En fait à l'origine le code était mis lors de la validation "BtnAjouter" mais compte tenu du plantage, j'ai essayé de le mettre dans l'afterupdate pour tester si cela plantait de le même manière, il est évident qu'il est préférable de le mettre lors de la validation!!!
Merci pour ton aide.
Bonjour à tous,
Petites questions, pourquoi faire difficile quand on peut faire simple ? Dans ces lignes :
VB:
W = Array(CbFournisseur1)
.ListRows.Add.Range.Cells(1).Resize(, 1) = W ' On ajoute la ligne à la base
Le tableau Fournisseurs ne comporte qu'une colonne alors pourquoi faire des Resize et autres Array() ?
Pourquoi laisser libre la condition vrai dans :
Code:
If Found Then
Else
With ws.ListObjects("TbFournisseur")
Dim W
'...
'...
Ne serait-il pas plus judicieux de passer par un Factory Pattern pour initialiser les Tableaux et colonnes des tableaux ? Cela éviterait de se peller tout le code si changement de noms.
Mettre Option Explicit en tête de module évitera pas mal de problèmes par la suite.
L'option Compare Text n'est valable que lors de l'utilisation de l'opérateur LIKE, l'opérateur "=" recherche une correspondance exacte, si vous voulez omettre la casse alors il faut lui préférer StrComp.
L'utilisation de RowSource pour les listes et listes déroulantes ne peut que poser des problèmes.
Dans ces lignes :
VB:
Set rng = f.Range("A2:F" & f.[a1000000].End(xlUp).Row)
vous pouvez utiliser les avantages des tableaux structurés.
La logique du formulaire est à revoir, vous avez un bouton enregistrer et un bouton Editer, alors que vous voulez que les lignes s'ajoutent sur un AfterUpdate.
Il est conseillé de travailler avec un ID pour les tableaux, l'ajout de lignes avec un nom identique, et une adresse différente par exemple doit-être possible.
Donc si l'on considère un module Factory de la sorte :
VB:
'@Folder "System"
Option Explicit
Public Type FournisseurColumns
ID As String
Nom As String
Adresse As String
Ville As String
End Type
Public Type ArticleColumns
Reference As String
Designation As String
PrixUnitaire As String
End Type
'@Description "Retourne un objet ListObject s'il existe sinon retourne Nothing"
Private Function getListObject( _
ByVal ListName As String, _
Optional ByVal Workbook As Excel.Workbook _
) As Excel.ListObject
Dim localWorkbook As Excel.Workbook
Set localWorkbook = Workbook
If localWorkbook Is Nothing Then Set localWorkbook = ThisWorkbook
With localWorkbook
Do
Dim CounterSheets As Integer
CounterSheets = CounterSheets + 1
Dim CounterListObjects As Integer: CounterListObjects = 0
With .Worksheets(CounterSheets)
Do While CounterListObjects < .ListObjects.Count And getListObject Is Nothing
CounterListObjects = CounterListObjects + 1
If StrComp(ListName, .ListObjects(CounterListObjects).Name, vbTextCompare) = 0 Then Set getListObject = .ListObjects(CounterListObjects)
Loop
End With
Loop While CounterSheets < .Worksheets.Count And getListObject Is Nothing
End With
End Function
'@Description "Initialise le tableau des données des fournisseurs."
Public Function InitTabFournisseurs( _
Optional ByVal Reset As Boolean _
) As ListObject
Static item As ListObject
If item Is Nothing Or Reset Then
Set item = getListObject("TbFournisseur")
End If
Set InitTabFournisseurs = item
End Function
'@Description "Initialise le tableau des données de base."
Public Function InitTabAchats( _
Optional ByVal Reset As Boolean _
) As ListObject
Static item As ListObject
If item Is Nothing Or Reset Then
Set item = getListObject("TbAchats")
End If
Set InitTabAchats = item
End Function
'@Description "Initialise le tableau des comptes."
Public Function InitTabComptes( _
Optional ByVal Reset As Boolean _
) As ListObject
Static item As ListObject
If item Is Nothing Or Reset Then
Set item = getListObject("TbComptes")
End If
Set InitTabComptes = item
End Function
'@Description "Retourne les noms de colonnes pour le tableau TbFournisseur."
Public Function GetFournisseurColumnNames( _
) As FournisseurColumns
Dim Columns As FournisseurColumns
With Columns
.ID = "ID"
.Nom = "Nom"
.Adresse = "Adresse"
.Ville = "Ville"
End With
GetFournisseurColumnNames = Columns
End Function
La méthode AfterUpdate pourait ressembler à ceci :
VB:
Private Sub CbFournisseur1_AfterUpdate()
Dim lstO As Excel.ListObject
Set lstO = Factory.InitTabFournisseurs
If Not lstO Is Nothing Then
' // Initialisation des entêtes de colonnes du tableau fournisseurs
Dim ColumnsNames As Factory.FournisseurColumns
ColumnsNames = Factory.GetFournisseurColumnNames
With lstO
If .ListRows.Count > 0 Then
Dim Found As Boolean
Dim itemRange As Excel.Range
For Each itemRange In .ListColumns(ColumnsNames.Nom).DataBodyRange
If StrComp(itemRange.Value, Me.CbFournisseur1.Value) = 0 Then Found = True: Exit For
Next itemRange
'Todo "La logique du formulaire est à revoir
If Not Found Then
Dim newRow As Excel.ListRow
Set newRow = .ListRows.Add
With newRow
'.Range(1).Value = CbFournisseur1.Value ' // Affectation directe
.Range(.Parent.ListColumns(ColumnsNames.ID).Index).Value = GetMaxId(lstO, ColumnsNames.ID) ' // Affectation par le nom de colonne
.Range(.Parent.ListColumns(ColumnsNames.Nom).Index).Value = CbFournisseur1.Text ' // Affectation par le nom de colonne
' .Range(.Parent.ListColumns(ColumnsNames.Adresse).Index).Value = vbNullString
' .Range(.Parent.ListColumns(ColumnsNames.Ville).Index).Value = vbNullString
End With
End If
End If
End With
End If
End Sub
Bonjour Valtrase,
Merci beaucoup pour votre réponse, par contre je ne connais pas du tout cette méthode, raison pour laquelle j'ai appliqué celle-ci.
Je vais tenter de comprendre la votre ,à tête reposée, qui a l'air top mais je ne suis pas sur que mes compétences soient assez complètes pour comprendre!!!
Merci beaucoup à tous pour ces éclaircissements.
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD
