VBA saisie d'un code postal et affichage auto des communes

Version imprimable

09/02/2012, 14h14
rattus34

VBA saisie d'un code postal et affichage auto des communes

Amis du forum slt,

j'ai très peu de connaissance en vba, mais je dois développer plusieurs bases de données EXCEL en passant par des formulaires.
Je dois dire que le temps me manque pour un apprentissage plus approfondi :(.
Je suis à la recherche d'un code VBA me permettant de saisir via un formulaire (FrmClients), dans une zone de texte (ZtxtCP), un code postal et dans une combobox (CboxVilles), l'affichage automatique des communes rattachées à ce même code postal, pour en permettre la selection.

Pour ce faire je dispose d'une base de donnée sur la feuil1(Bd_Villes34) colonne A:Codes postaux et colonne B:Les villes
comme suit :
A_______B
34000 MONTPELLIER
34060 MONTPELLIER
34070 MONTPELLIER
34080 MONTPELLIER
34090 MONTPELLIER
34110 MIREVAL
34113 FRONTIGNAN
34116 VIC LA GARDIOLE
34120 CASTELNAU DE GUERS
34120 CAZOULS D'HERAULT
34120 LEZIGNAN LA CEBE
34120 NEZIGNAN L'EVEQUE
34120 PEZENAS
34120 TOURBES
34130 CANDILLARGUES
34130 LANSARGUES
34130 MAUGUIO
34130 MUDAISON
34130 SAINT AUNES
34130 VALERGUES
etc...

J'espère vous avoir donné suffisament d'info.
Merci pour vos suggestions

Bonjour,

Deux possibilités, juste pour toi...

1- Un textBox de saisie et une combobox (ce que tu demandes quoi)
A la sortie du TextBox, il remplit la combobox.
A adapter : le nom de la feuille, dans l'exemple "Feuil1"
Le code VBA est :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub ZtxtCP_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Trouve As Range, firstAddress As String
 
'*********TESTS A FAIRE**********
'* Tester le contenu du TextBox *
'********************************
CboxVilles.Clear
With Sheets("Feuil1")
    Set Trouve = .Columns(1).Cells.Find(ZtxtCP, lookat:=xlWhole)
    If Trouve Is Nothing Then
        MsgBox "Valeur non trouvée"
    Else
        firstAddress = Trouve.Address
        Do
            CboxVilles.AddItem .Range("B" & Trouve.Row)
            Set Trouve = .Columns(1).Cells.FindNext(Trouve)
        Loop While Not Trouve Is Nothing And Trouve.Address <> firstAddress
    End If
End With
Set Trouve = Nothing
End Sub

2- 1 TextBox et une ListBox :
A chaque chiffre saisi dans le textbox, la listbox se "rafraichit"... A voir...

Code:

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
Private Sub ZtxtCP_Change()
'd'après un code de Michel_m
Dim Tablo
Dim lettre As String, test As String
Dim cptr As Integer, cptr_tablo As Integer, derLig As Integer
 
lettre = UCase(ZtxtCP.Value)
If lettre = "" Then Exit Sub
ReDim Tablo(0)
ListboxVilles.Clear
derLig = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
With Sheets("Feuil1")
    For cptr = 1 To derLig
        test = .Cells(cptr, 1)
         If .Cells(cptr, 1) Like lettre & "*" Then
            Tablo(cptr_tablo) = .Cells(cptr, 2)
            cptr_tablo = cptr_tablo + 1
            ReDim Preserve Tablo(cptr_tablo)
        End If
Next
End With
For cptr_tablo = LBound(Tablo) To UBound(Tablo)
    ListboxVilles.AddItem Tablo(cptr_tablo)
Next
End Sub

Et comme tu as été bien sage ;-) voici un fichier exemple avec tes données...

Bonjour,
simplement, j'avais préparé ce code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Dim derlg As Integer, plage As Range, cel As Range
 
Private Sub CP_Click()
ville.Clear
For Each cel In plage
  If cel = CP Then
    ville.AddItem cel.Offset(0, 1)
  End If
Next cel
End Sub
 
Private Sub UserForm_Activate()
With Sheets("Bd_Villes34")
  derlg = .Range("A" & .Rows.Count).End(xlUp).Row
  Set plage = .Range("A2:A" & derlg)
  For Each cel In plage
    CP.AddItem cel
  Next cel
End With
End Sub

10/02/2012, 15h04
rattus34

Merci!

Merci pour vos solutions, casefayere je n'ai pas eu le temps de tester ta proposition, mais c'est vraiment sympa d'y avoir consacré une partie de ton temps.
La Première étant la bonne, pijaku :ccool:
Je pense que ça resservira pour d'autres.
Merci encore !