Problème de liaison de deux combobox et la saisie semi-automatique pour le deuxième

[INFINITY100]

Bonsoir tout le monde

Voila je cherche à résoudre un problème qui concerne la liaison de deux Combobox un dans un UserForm et l'autre dans une feuille et ajouter une saisie semi-automatique je possède une mais elle fonction que dans UserForm et j'ai trouvé la macro ci-dessous pour le Combobox de la feuille mais elle génère une erreur ... pourriez-vous m'aider

Je joins le fichier pour être plus claire

Option Explicit
Dim a, d1()
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  a = [liste].Value
  Me.ComboBox1.List = a
End Sub

Private Sub ComboBox1_Change()
  Set d1 = CreateObject("Scripting.Dictionary")
  tmp = UCase(Me.ComboBox1) & "*"
  For Each c In a
  If UCase(c) Like tmp Then d1(c) = ""
        Me.ComboBox1.List = d1.keys
  Me.ComboBox1.DropDown
  Next
End Sub
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = 13 Then ActiveCell = Me.ComboBox1: Unload Me
End Sub

Cordialement

Merci d'avance

 

[BOISGONTIER]

Re : Problème de liaison de deux combobox et la saisie semi-automatique pour le deuxi

Bonsoir,

J'ai pas compris le but

JB

 

[INFINITY100]

Re : Problème de liaison de deux combobox et la saisie semi-automatique pour le deuxi

Bonsoir

Le but est simple c'est quand je choisis un verbe du Combobox de UserForm de la feuille1 il copie ce même verbe vers le Combobox se trouvant en feuille2, ensuite quand je cherche un autre verbe dans ce même Combobox (c'est à dire celui en feuille2) il aura à son tour l'option de la saisie semi-automatique c'est à dire lui appliquer cette macro.

Dim f, choix1()
Private Sub UserForm_Initialize()
 Set f = Sheets("LISTE DES VERBES")
  choix1 = Application.Transpose(f.Range("a2:A" & f.[A1048576].End(xlUp).Row))
  Me.ComboBox1.List = choix1
End Sub
Private Sub ComboBox1_Change()
 If Me.ComboBox1.ListIndex = -1 And IsError(Application.Match(Me.ComboBox1, choix1, 0)) Then
   Me.ComboBox1.List = Filter(choix1, Me.ComboBox1.Text, True, vbTextCompare)
   Me.ComboBox1.DropDown
    
    End If
  
  Application.ScreenUpdating = True
  
End Sub

Car c'est là que je me coince c'est comment l'appliquer en dehors de l'UserForm

Merci

 

[BOISGONTIER]

Re : Problème de liaison de deux combobox et la saisie semi-automatique pour le deuxi

Bonjour,

Voir PJ

JB

 

[INFINITY100]

Re : Problème de liaison de deux combobox et la saisie semi-automatique pour le deuxi

Merci beaucoup Boisgontier

c'est formidable c'est exactement le résultat attendu

Merci

 

[INFINITY100]

Re : Problème de liaison de deux combobox et la saisie semi-automatique pour le deuxi

Re Slt

Voila un petit soucis en arrêtant sur la feuille 5 et fermant le document puis en le ré ouvrant sur la même feuille dés la tape dans le Combobox il génère une erreur dans la macro ci-dessous qui est : " Boucle For non initialisée " pour que ça fonctionne il faut toujours cliquer sur une autre feuille puis revenir pour que ça marche

y a t-il un moyen d'éviter cela ?

Option Explicit
Dim a(), d1, tmp, c
Private Sub Worksheet_Activate()
  a = [liste].Value
  Me.ComboBox1 = [A1]
  Me.ComboBox1.List = a
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  a = [liste].Value
  Me.ComboBox1.List = a
End Sub
Private Sub ComboBox1_Change()
  Set d1 = CreateObject("Scripting.Dictionary")
  tmp = UCase(Me.ComboBox1) & "*"
  For Each c In a
    If UCase(c) Like tmp Then d1(c) = ""
  Next c
  Me.ComboBox1.List = d1.keys
  Me.ComboBox1.DropDown
  [B1] = Me.ComboBox1
End Sub

Merci

Voir le fichier joint

 

[BOISGONTIER]

Re : Problème de liaison de deux combobox et la saisie semi-automatique pour le deuxi

Voir PJ

Option Explicit
Dim a(), d1, tmp, c, témoin
Private Sub Worksheet_Activate()
  a = [liste].Value
  Me.ComboBox1 = [A1]
  Me.ComboBox1.List = a
  témoin = True
End Sub

Private Sub ComboBox1_Change()
  If Not témoin Then a = [liste].Value: Me.ComboBox1.List = a: témoin = True
  Set d1 = CreateObject("Scripting.Dictionary")
  tmp = UCase(Me.ComboBox1) & "*"
  For Each c In a
    If UCase(c) Like tmp Then d1(c) = ""
  Next c
  Me.ComboBox1.List = d1.keys
  Me.ComboBox1.DropDown
  [B1] = Me.ComboBox1
End Sub

JB

 

[mapomme]

Re : Problème de liaison de deux combobox et la saisie semi-automatique pour le deuxi

Bonjour INFINITY100 , BOISGONTIER,

Une version v3.a qui doit intégrer tes demandes de modifications. La recherche intuitive est un peu différente de celle demandée.

Pour sélectionner un item, il faut cliquer sur l'élément qu'on veut choisir dans la liste (que ce soit pour la liste des produits du userform 'MENU' ou pour la liste des produits de la feuille 'Feuil5'.

Pour quitter une fenêtre ou la liste de la feuille 'Feuil5', il faut appuyez sur la touche Escape.

Notez : pour quitter la liste intuitive de l'userform 'MENU' ou de la feuille 'Feuil5', il faut un appui prolongé sur la touche Escape.

 

[mapomme]

Re : Problème de liaison de deux combobox et la saisie semi-automatique pour le deuxi

Bonjour à tous,

Une version V3.b qui s'affranchit des accents pour la recherche (par ex: une recherche avec one donne la liste des produits avec le mot cône tout comme une recherche avec ône)

 

[INFINITY100]

Re : Problème de liaison de deux combobox et la saisie semi-automatique pour le deuxi

Bonjour MAPOMME , BOISGONTIER,

Franchement remarquable travail messieurs je vous remercie du fond du cœur vraiment c'est un travail de pro et c'est le résultat attendu.

là je pourrai passer à l'autre étape de la réalisation de mon fichier et quand j'aurai un problème je vous solliciterai de nouveau

Merci encore c'est très gentil messieurs

 

[INFINITY100]

Re : Problème de liaison de deux combobox et la saisie semi-automatique pour le deuxi

MAPOMME

Oups après essais d'ajouter un nouveau produits la macro donne erreur "Propriété ou méthode non gérée par cet objet"

Private Sub Ajouter_Click()

  ' la première lettre en majuscule
  DesignationBox = Trim(DesignationBox)
  DesignationBox = UCase(Left(DesignationBox, 1)) & Mid(DesignationBox, 2)
  If DesignationBox = "" Then
    ' Si le nouvel article est vide
    MsgBox "Désignation obligatoire !", vbOKOnly, "Ajout impossible..."
  ElseIf dico.exists(DesignationBox.Value) Then
    ' Si le nouvel article existe déjà
    MsgBox DesignationBox & "-> déjà existant", vbOKOnly + vbCritical, "Ajout impossible..."
    DesignationBox.SetFocus
    Exit Sub
  Else
    ' C'est bien un nouvel article non vide, on l'ajoute à dico
    dico.Add DesignationBox, dico.Count
    With Sheets("Feuil2")
      ' on inscrit la liste des produits sur Feuil3
      .Range("a2").Resize(dico.Count) = Application.Transpose(dico.keys)
      ' Tri de la liste
      .Range("a1").Resize(dico.Count + 1).Sort Key1:=.Range("a1"), order1:=xlAscending, Header:=xlYes
      ' Bordures
      .Range("a:a").Borders.LineStyle = xlLineStyleNone
      .Range("a1").Resize(dico.Count + 1).Borders.LineStyle = xlContinuous
      ' On appelle UserForm_Initialize pour réinitialise Dico avec
      ' les produits triés
      UserForm_Initialize
      ' On affecte à ComboBox1 la nouvelle liste des preoduits triés
      ' Produits est un nom dynamique défini par :
      ' =DECALER(Feuil2!$A$1;1;0;NBVAL(Feuil2!$A:$A)-1;1)
      ' voir menu Formule / Gestionnaire de noms
      Sheets("Feuil1").ComboBox1.ListFillRange = "Produits"
      MsgBox "L'Article <" & DesignationBox & "> a été ajouté"
      DesignationBox = ""
      DesignationBox.SetFocus
    End With
  End If
End Sub

Exactement à la ligne

Sheets("Feuil1").ComboBox1.ListFillRange = "Produits"

Merci

 

[INFINITY100]

Re : Problème de liaison de deux combobox et la saisie semi-automatique pour le deuxi

j'ai essayé ceci mais ça marche pas aussi

MENU.ComboBox1.ListFillRange = "Produits"

 

[mapomme]

Re : Problème de liaison de deux combobox et la saisie semi-automatique pour le deuxi

Bonsoir INFINITY100,

Effectivement, mon travail de vérification a été trop succinct.

Point n°1:

Pendant la phase de mise au point, j'ai utilisé un nom dynamique Produits défini par la formule : =DECALER(Feuil2!$A$1;1;0;NBVAL(Feuil2!$A:$A)-1;1) à l'aide du menu "Formule / définir un nom".

Comme ce nom n'existe peut-être pas dans votre fichier, ça peut planter .

La version v3.c se charge de définir ce nom Produits à l'ouverture du fichier dans le module de ThisWorkbook dans la procédure Workbook_Open(). On ne touche donc pas au reste du code.

Private Sub Workbook_Open()
  ActiveWorkbook.Names.Add Name:="Produits", RefersToR1C1:= _
      "=OFFSET(Feuil2!R1C1,1,0,COUNTA(Feuil2!C1)-1,1)"
End Sub

Point n°2:

Comme j'ai changé plusieurs fois mon fusil plusieurs fois d'épaule, la ligne incriminée qui provoque une erreur est un reliquat d'une ancienne version (ComboBox1 n'existe plus)

J’ai modifié le code du module du UserForm "AjoutArticle" pour éliminer ce qu'il restait des anciennes versions.


Point n°3:

J'en ai aussi profité pour ne pas tenir compte des accents sur le UserForm "AjoutArticle".

J'espère que tout rentrera dans l'ordre. J'assurerai le SAV dans le cas contraire .

---

ERRATA : la demande de SAV n'a pas tardé . Préférez la version INFINITY100-Exemple-v3.d.xlsm qui corrige un bogue de la fonction Apurer au sein du code. Cette version se trouve ICI

 

[INFINITY100]

Re : Problème de liaison de deux combobox et la saisie semi-automatique pour le deuxi

Remarquable MAPOMME

Merci ma pomme le fichier forcement sera to be continued lol

 

[INFINITY100]

Re : Problème de liaison de deux combobox et la saisie semi-automatique pour le deuxi

Bonjour Mapomme

Voila après avoir compris le rôle de chaque macro grâce aux commentaires je me suis arrêté sur une qui me fait des maux de tête car je ne comprend pas vraiment son rôle pour cause du manque de commentaire

Voici la macro et surtout la Sub test en dernier hhh

Function Apurer$(x)
Static dicoSubst As Object
Dim i&, couple, Item01, y, k&, c$
Const Subst = "Š|S Œ|OE Ž|Z š|s œ|oe ž|z Ÿ|Y ¡|I ¢|C ²|2 ³|3 ¹|1 À|A Á|A Â|A Ã|A Ä|A Å|A Æ|AE Ç|C È|E É|E Ê|E Ë|E Ì|I Í|I Î|I Ï|I Ñ|N Ò|O Ó|O Ô|O Õ|O Ö|O Ù|U Ú|U Û|U Ü|U Ý|Y à|a á|a â|a ã|a ä|a å|a æ|ae ç|c è|e é|e ê|e ë|e ì|i í|i î|i ï|i ñ|n ò|o ó|o ô|o õ|o ö|o ø|0 ù|u ú|u û|u ü|u ý|y ÿ|y"

  If dicoSubst Is Nothing Then
    Set dicoSubst = CreateObject("Scripting.dictionary")
    For Each couple In Split(Subst)
      Item01 = Split(couple, "|")
      dicoSubst.Add Item01(0), Item01(1)
    Next couple
  End If
  
  y = x: k = Len(y)
  For i = 1 To k
    c = Mid(y, i, 1)
    If dicoSubst.exists(c) Then Mid(y, i, 1) = dicoSubst(c)
  Next i
  Apurer = y
End Function

Sub test()
  MsgBox Apurer("éèçàù")
  MsgBox Apurer("ÄÔ")
End Sub

Merci d'avance pour la précision