ComboBox Code PostalVille inter changeables

Bonjour à tous, membres du forum ! (Et bonne année en passant !)

Vous m'avez été à plusieurs reprises d'un grande aide et je vous en remercie chaleureusement. Une nouvelle énigme pour vous, et pour laquelle je ne trouve pas ma réponse (car amatrice) !

Depuis que je vadrouille de droite et de gauche sur les forums, les tutos je suis parvenu à rédiger un petit code pour remplir Les ComboBoxs d'un UserForm. Pourtant deux points me chagrinent.

Mon Fichier (UN FACTURIER ET ORGANE DE GESTION POUR MON ENTREPRISE) anonyme et incomplet (sur cette version) comporte une feuille DataBase dans laquelle, se trouve des données : Code Postal et Villes correspondantes ainsi que deux UserForm qui servent à enregistrer des contacts particuliers / professionnels. ( Ci Nommés : FormulairPart et FormulairPro. Dans ce fichier, mes codes "private initialize" et "ComboBox Change", bien que très certainement perfectibles ( j'attend vos critiques) fonctionnent.

Leur Fonction:

Private Sub UserForm_Initialize
 'Remplir les Combos
Dim i As Integer, x As Integer
i = Sheets("DataBase").Range("A:C").End(xlDown).Row + 3232
For x = 1 To i

   With CombOrigin1
    .AddItem Sheets("DataBase").Range("A" & x)
    End With
    With ComboCodPost
    .AddItem Sheets("DataBase").Range("B" & x)
    End With
     With ComboVille
    .AddItem Sheets("DataBase").Range("C" & x)
    End With
   Next x

End Sub

Private Sub ComboCodPost_Change()
'Si mon code change, trouver les villes associées

Application.ScreenUpdating = False
Worksheets("Database").Select
    Dim lign As Long

    If ComboCodPost <> "" Then
        lign = ComboCodPost.ListIndex + 1
            ComboCodPost = Range("B" & lign).Value
        ComboVille.Value = Range("C" & lign).Value
    End If

End Sub

Private Sub ComboVille_Change()
'Si les villes changent, trouver lee code postal associé.
Application.ScreenUpdating = False
Worksheets("Database").Select
    If ComboVille <> "" Then
        lign = ComboVille.ListIndex + 1
            ComboCodPost = Range("B" & lign).Value
        ComboVille.Value = Range("C" & lign).Value
    End If

   Worksheets("Database").Select
End Sub

Mes Problèmes :

1) Mes codes Postaux et villes ne concernent que les départements dans lesquels mon entreprise intervient. Mais parfois, si un client a une résidence secondaire, et qu'il habite à Paris, je lui envoie la facture à son domicile. Hors je ne peux, dès lors que mon ComboBox se réfère à une liste, entrer un code et une ville librement = c'est direct débogage sur la ligne: ComboVille.Value = Range("C" & lign).Value. Ma QUESTION : Est-il possible de modifier le code pour avoir la possibilité en plus de ma liste d''ecrire librement un code postal et/ ou une ville.

2) Ce code précisemént fonctionne sur ce fichier que j'ai copié pour sauvegarde de mon travail. Sur mon fichier d'origine, LE FACTURIER sur lequel je travail et sur lequel j'ai encore plus avancé, Ce Même Code Avec Ces Memes Donées NE FONCTIONNE PLUS ! Impossible de renseigner la ville :

Si je souhaite taper par exemple "RIBERAC" qui est dans ma feuille (DataBase), Le ComboVille ne se remplie pas et le code postal associé n'est pas trouvé... Je ne comprend pas pourquoi.

Ci joint Mon fichier de sauvegarde qui fonctionne ... Peut être trouverez vous solutions à ces problèmes.

Par avance Merci beaucoup !

Elodie

Désolé, Je viens de constater que mon fichier n'est pas das le message et pour cause : trop volumineux ...

Je chercher une solution et je le joint .

Bonsoir

A tester

Bonsoir Banzai !

Que dire ! Encore une fois tu solutionne, en quelques minutes, un problème sur lequel je planche pendant des heures !

1000 Mercis !

Reste que lorsque j'inscrit la ville (Paris par exemple) le code postal qui s'est inscris avec les premières lettres ne s'efface pas mais j'ai juste à l'effacer à la main pour ajouter le nouveau... A moins que je ne trouve une ligne de code qui dit : "si la ville inscrite est différente de celles qu'il y a dans la liste définie, alors effacer le ComboBox Code postal

Sinon, la fonction "voulez vous ajouter le code postal et la ville" : du bonheur !

Encore merci !

Elodie

Bonsoir

Ne connaissant pas tes habitudes de saisies des informations j'ai laissé telle quelle la propriété MatchEntry des combobox

Si tu veux tu peux les changer, essaie fmMatchEntryNone, cela te laissera entière liberté de saisir ce que tu veux dans les ComboBox

C'est entendu, j'adapte ,dans un premier temps, ta macro sur mon fichier d'origine et je me penche sur MatchEntry en suivant.

Je suis déjà trop heureuse que cela fonctionne !

Encore merci à une prochaine macro !

Elodie

Bonjour,

Choix de la ville ou du Code postal avec saisie intuitive type Google.

• En frappant les premières lettres de la ville,les noms des villes apparaissent dans le combobox Ville
• En frappant les premières caractères du code postal, les codes postaux apparaissent dans le combobox code postal

Private Sub ComboVille_Change()
 On Error Resume Next
 If ActiveControl.Name <> "ComboVille" Then Exit Sub
 On Error GoTo 0
 If Me.ComboVille.ListIndex = -1 And _
     IsError(Application.Match(Me.ComboVille, Application.Index(ListeVille, , 1), 0)) Then
     Dim b()
     Me.CodePostal = ""
     clé = UCase(Me.ComboVille) & "*"
     n = 0
     For i = LBound(ListeVille) To UBound(ListeVille)
       If UCase(ListeVille(i, 1)) Like clé Then
         n = n + 1: ReDim Preserve b(1 To 2, 1 To n)
         b(1, n) = ListeVille(i, 1): b(2, n) = ListeVille(i, 2)
       End If
      Next i
      If n > 0 Then
        ReDim Preserve b(1 To 2, 1 To n + 1)
        Me.ComboVille.List = Application.Transpose(b)
        Me.ComboVille.RemoveItem n
      End If
      Me.ComboVille.DropDown
   Else
      On Error Resume Next
      Me.CodePostal = Me.ComboVille.Column(1)
   End If
End Sub
Private Sub B_ajout_Click()
  ligneEnreg = f.[A65000].End(xlUp).Row + 1
  Me.ChoixNom = ""
  Me.Nom = ""
  Me.ComboService = ""
  Me.ComboVille = ""
  Me.CodePostal = ""
  Me.Activité = ""
  Me.Nom.SetFocus
End Sub

Private Sub CodePostal_Change()
 On Error Resume Next
 If ActiveControl.Name <> "CodePostal" Then Exit Sub
 On Error GoTo 0
 If Me.CodePostal.ListIndex = -1 And _
     IsError(Application.Match(Me.CodePostal, Application.Index(ListeVille, , 2), 0)) Then
     Dim b()
     clé = UCase(Me.CodePostal) & "*"
     n = 0
     For i = LBound(ListeVille) To UBound(ListeVille)
       If UCase(ListeVille(i, 2)) Like clé Then
         n = n + 1: ReDim Preserve b(1 To 2, 1 To n)
         b(1, n) = ListeVille(i, 2): b(2, n) = ListeVille(i, 1)
       End If
      Next i
      If n > 0 Then
        ReDim Preserve b(1 To 2, 1 To n + 1)
        Me.CodePostal.List = Application.Transpose(b)
        Me.CodePostal.RemoveItem n
      End If
      Me.CodePostal.DropDown
   Else
      On Error Resume Next
      Me.ComboVille = Me.CodePostal.Column(1)
   End If
End Sub

Ceuzin