Discussion :

[NEC14]

Bonjour à tous,

J'ai une Combo qui est alimentée par des données se trouvant dans la feuille "Base_Produits", des cellules A8:A1007. Les données sont sous la forme P0001, P0002? etc... jusqu'à P01000.
J'aimerai savoir comment faire pour les codes produits déjà utilisés n'apparaissent plus dans ma Combo. Par exemple, si j'utilise P0001, alors la prochaine fois que j'ouvrirai mon UF où se trouve la Combo, alors la Combo devra proposer les codes à partir de P0002, le code P0001 n'apparaissant plus puisque déjà utilisé.

J'espère avoir été clair dans mes explications. Merci par avance pour l'aide que vous pourrez m'apporter.

Bien amicalement

[boisgontierjacques]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim f
Private Sub UserForm_Initialize()
  Set f = Sheets("feuil1")
  a = f.Range("A2:A" & f.[A65000].End(xlUp).Row)
  b = f.Range("c2:c" & f.[c65000].End(xlUp).Row)
  Me.ComboBox1.List = Diff(a, b)
End Sub
 
Function Diff(a, b)
  Set MonDico1 = CreateObject("Scripting.Dictionary")
  For Each c In b: MonDico1(c) = c:  Next c
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For Each c In a
    If Not MonDico1.Exists(c) Then mondico2(c) = c
  Next c
  Diff = mondico2.keys
End Function

Boisgontier

[NEC14]

Bonjour Jacques,

Merci beaucoup, je n'aurai jamais trouvé seul. Tu m'enlèves une grosse épine du pied.
Salutations amicales

[NEC14]

Je me suis réjouit un peu vide. Lorsque j'appelle mon UF un message d'erreur apparait : "Erreur 70 Permission refusée". Je ne vois pas ce qui cloche.
L'erreur est située ici dans ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub Button_Bas_Prod_Click()
Application.ScreenUpdating = False

    Sheets("Base_Produits").Visible = True
    Sheets("Base_Produits").Activate
    
Application.ScreenUpdating = True
    Load UFProduits 'Erreur sur cette ligne
    UFProduits.Show
End Sub

Voici le code donné par Jacques modifié selon mes besoins :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Dim f
Private Sub UserForm_Initialize()
  Set f = Sheets("Base_Produits")
  a = f.Range("A2:A" & f.[A65000].End(xlUp).Row)
  b = f.Range("B2:B" & f.[B65000].End(xlUp).Row)
  Me.CmbCodeProd.List = Diff(a, b)
End Sub
 
Function Diff(a, b)
  Set MonDico1 = CreateObject("Scripting.Dictionary")
  For Each c In b: MonDico1(c) = c:  Next c
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For Each c In a
    If Not MonDico1.Exists(c) Then mondico2(c) = c
  Next c
  Diff = mondico2.keys
End Function

Dans un module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Function Diff(champ1 As Range, champ2 As Range)
  Set MonDico1 = CreateObject("Scripting.Dictionary")
  a = champ1.Value
  b = champ2.Value
  For Each c In b: MonDico1(c) = c:  Next c
  Set mondico2 = CreateObject("Scripting.Dictionary")
  For Each c In a
    If Not MonDico1.Exists(c) Then mondico2(c) = c
  Next c
  Dim d()
  ReDim d(1 To Application.Caller.Rows.Count)
  i = 1
  For Each c In mondico2.items
     d(i) = c
     i = i + 1
  Next c
  Diff = Application.Transpose(d)
End Function

[boisgontierjacques]

La fonction du module ne sert à rien.

Les éléments choisis sont-ils bien sur la feuille Base_produits

Si ce n'est pas le cas:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
  set f2=sheets("xxxxxx")
  b = f2.Range("B2:B" & f2.[B65000].End(xlUp).Row)

Boisgontier

[NEC14]

Jacques,

Oui les éléments choisis sont bien dans la feuille "Base_Produits". Je vais supprimer le module et retenter le coup.
Merci pour ton aide

[boisgontierjacques]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Dim f,f2
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  n = f.[A65000].End(xlUp).Row
  a = f.Range("A2:A" & n)
  Set f2 = Sheets("Choisis")
  b = f2.Range("C2:C" & n)
  Me.ComboBox1.List = Diff(a, b)
End Sub
 
Private Sub B_ok_Click()
  f2.Cells(f2.[C65000].End(xlUp).Row + 1, "c") = Me.ComboBox1
  n = f.[A65000].End(xlUp).Row
  a = f.Range("A2:A" & n)
  Set f2 = Sheets("Choisis")
  b = f2.Range("C2:C" & n)
  Me.ComboBox1.List = Diff(a, b)
End Sub
 
Function Diff(a, b)
  Set d1 = CreateObject("Scripting.Dictionary")
  For Each c In b: d1(c) = c:  Next c
  Set d2 = CreateObject("Scripting.Dictionary")
  For Each c In a
    If Not d1.Exists(c) Then d2(c) = c
  Next c
  Diff = d2.keys
End Function

Boisgontier

[patricktoulon]

re
Bonjour
il y a peut etre une solution sans dictionnaire
dans un module standard

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Public liste

dans le userform

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim index As Long
Dim suppr As Boolean
Private Sub ComboBox1_Click()
index = ComboBox1.ListIndex
suppr = True
End Sub
Private Sub UserForm_Activate()
    With ComboBox1
        If IsEmpty(liste) Then .List = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value Else .List = liste
    End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
   If suppr = True Then ComboBox1.RemoveItem (index)
    liste = ComboBox1.List
End Sub

1. a l'activate de l'UserForm :la combo prend liste comme liste si elle contient quelque chose sinon ta plage .value
2. au click de la combo : la variable suppr est mise a true et index prend le .listindex de la combo
3. a la fermeture du UserForm :si suppr est true alors on remove l'item index et liste est remis a jours avec le .list de la combo

sans dictionnaire et sans colonne sur sheet pour memoriser

[NEC14]

Bonjour Patrick, Bonjour Jacques,

Patrick, j'ai essayé ton code, mais j'ai le même message d'erreur "Erreur 70 Permission refusée"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub UserForm_Activate()
    With CmbCodeProd
        If IsEmpty(liste) Then .List = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value Else .List = liste 'ici est le problème 
    End With
End Sub

[NEC14]

Jacques,

J'ai également essayé ton code, mais même problème, même message. En fait le programme ne veut pas afficher mon UF, à chaque fois ça bug sur ces deux lignes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Load UFProduits
UFProduits.Show

[NEC14]

Je me suis peut-être mal expliqué au début de ma question. Ma Combo (CmbCodeProd) est toujours alimentée par les données se trouvant dans la colonne A8:A1007 de la feuille Base_Produits.

Donc, les codes articles P0001 à P1000 existe déjà et ils ne seront jamais reportés ailleurs, ils sont déjà à leur place. L'utilisateur pourra donc choisir les codes à la suite des uns des autres au fur et à mesure des saisies complémentaires dans le tableau qui est vide pour le moment, il sera rempli au moment des réceptions de produits.

Désolé si je me suis mal expliqué dès le début

[boisgontierjacques]

Bonjour,

Plutôt que de jouer aux devinettes, il serait intéressant d'avoir le fichier.


Boisgontier

[NEC14]

Voici un morceau du fichier, la partie concernée par mon problème
Prendre le 2ème fichier le 1er n'est pas bon. Je n'arrive pas à le retirer

[patricktoulon]

re

allons nec14!!!
ceci explique cela

quand tu utilise rowsource tu ne peut pas modifier la liste de ta combo du moins il me semble hein !!!!

il faudra m'explique aussi ceci

[NEC14]

Je ne savais pas pour le Rowsource, je vais modifier ça.

Pour le reste, ça fonctionne bien, je ne comprends pas ton inquiétude !! Quand je valide, les cases se remplissent bien avec les données du formulaire


J'ai donc remplacé le RowSource par ce code : et je vais retenter les codes que vous m'avez proposé tous les deux

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Private Sub UserForm_Initialize()
Me.CmbCodeProd.List = Range("Feuil1!A8:A1007").Value
End Sub

[NEC14]

Bonjour à tous, Bonjour Patrick, Bonjour Jacques,

J'ai donc remis le code de Patrick dans mon projet mais cela ne fonctionne pas, j'ai essayé avec le tien Jacques mais sans succès également.

Je remets le fichier modifié en pièce jointe, vous verrez que les deux premières lignes du tableau sont remplies, donc normalement ma Combo ne devrait afficher la liste qu'à partir de P0003 mais elle reprend les 2 premiers qui sont déjà utilisés.

Merci par avance pour votre aide
Essais.xlsm

[patricktoulon]

re
vraiment nec14 tu a aucunes excuses depuis le temps que tu bidouille dans vba il y a des chose elementaires

c'est normal que ca ne marche pas avant de fermer tu vide les controls dans valider ,forcement dans le queryclose le .listindex est -1 donc ca ne peut pas marcher bien evidement

le code du queryclose va dans le click de valider

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub CmbValide_Click()
    With ThisWorkbook.ActiveSheet
        L& = Application.Max(.Cells(.Rows.Count, 2).End(xlUp).Row, 2) + 1
            .Cells(L, 2).Resize(, 6).Value = Array(Me.TxtDescrip.Value, Me.TxtPrixV.Value, Me.CmbTVA.Value, Me.TxtRemar.Value, "", Me.TxtPrixA.Value)
    End With
  If suppr = True Then CmbCodeProd.RemoveItem (index)
    Liste = CmbCodeProd.List
 
            Me.CmbCodeProd.Value = ""
            Me.TxtDescrip.Value = ""
            Me.TxtPrixV.Value = ""
            Me.CmbTVA.Value = ""
            Me.TxtRemar.Value = ""
            Me.TxtPrixA.Value = ""
End Sub

allo la lune !!!!
et tu supprime le query close bien entendu je te le dis au cas ou hein !!!

[NEC14]

Patrick,

Oui dans l'empressement je n'ai pas vu cette erreur, merci de me l'avoir fait remarquer.
J'ai donc modifié le code suivant tes recommandations, mais le résultat est le même. Tous les items sont la combo, même ceux déjà utilisés.
Voici les codes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
Private Sub CmbValide_Click()
    With ThisWorkbook.ActiveSheet
        L& = Application.Max(.Cells(.Rows.Count, 2).End(xlUp).Row, 2) + 1
            .Cells(L, 2).Resize(, 6).Value = Array(Me.TxtDescrip.Value, Me.TxtPrixV.Value, Me.CmbTVA.Value, Me.TxtRemar.Value, "", Me.TxtPrixA.Value)
    End With
 
            If suppr = True Then CmbCodeProd.RemoveItem (index)
    Liste = CmbCodeProd.List
 
            Me.CmbCodeProd.Value = ""
            Me.TxtDescrip.Value = ""
            Me.TxtPrixV.Value = ""
            Me.CmbTVA.Value = ""
            Me.TxtRemar.Value = ""
            Me.TxtPrixA.Value = ""          
 
End Sub
 
Private Sub CmbCodeProd_Click()
index = CmbCodeProd.ListIndex
suppr = True
End Sub
 
Private Sub UserForm_Activate()
    With CmbCodeProd
        If IsEmpty(Liste) Then .List = Range("A8", Cells(Rows.Count, 1).End(xlUp)).Value Else .List = Liste
    End With
End Sub

[patricktoulon]

re
ma fois le code est tellement simple , tu dois avoir un code quelque part qui touche a ta combo

la je peux plus rien pour toi chez moi ca fonctionne tres bien
des que un item est selectionné , rempli les textbox et cliquer valider l'item n'apparait plus dans la combo la fois suivante que le userform est affiché

[NEC14]

Patrick,

J'ai trouvé mon erreur, c'est vraiment tout bête. Lorsque je fais un choix dans la combo, je dois tabuler, pas passer à la suite à l'aide de la souris.
Par contre, je rencontre un autre soucis, si j'efface ma ligne, tout en gardant la colonne A intacte, les items qui avaient été utilisés n'apparaissent plus.
Il y a t'il un moyen de remédier à ça ?
Merci par avance