Discussion :

[maxval18]

Bonsoir à tous,

Voila j'ai un USF avec 1 combobox et une Listbox je recherche avec ma combobox dans la colonne "B" les code postaux et j'aimerais que les noms ville se trouvant dans la colonnes "K" correspondant aux code s"affiche dans la listbox.
En sachant que la liste des Code postaux et des villes font environ 38000 lignes.

Merci d'avance

Cordialement

Max

[casefayere]

le principe est le meme que sur ta dernière demande, tu devrais pouvoir l'adapter ou tu n'as pas compris les codes que je t'ai fournis

[maxval18]

Re,

Oui j'ai ajouté quelques supplément mais je n'ai pas un niveau assez haut donc j'avance doucement.

@+

Max

Re,

J'ai ajouter ceci:

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
Private Sub ComboBox_ville_cp2_Change()
Dim CP As Range, Lg As Long
 
If ComboBox_ville_cp2 = "" Then Exit Sub
With Feuil1
  Set CP = .Range("B:B").Find(ComboBox_ville_cp2.Value, LookIn:=xlValues, lookat:=xlWhole)
  If Not CP Is Nothing Then
    Lg = CP.Row
    ListBox1.Clear
    While .Range("B" & Lg) = CP
      ListBox1.AddItem .Range("K" & Lg)
      Lg = Lg + 1
    Wend
  End If
End With
End Sub

Quand pense tu ?

@+

Max

[casefayere]

le fichier est-il toujours le même (même disposition, mêmes colonnes) ?
Si c'est le cas, il faut déjà que tu élimines les doublons dans la combobox,
Je viens de voir que tu n'utilises pas de variable tableau, en conséquence le traitement risque d'être long, surtout pour plus de 38000 lignes.
Je vais essayer, si j'ai le temps (et si le fichier est le même) , de te préparer quelque chose avec les explications, mais pas sur pour ce soir.

Voilà,
je te rends l'ancien fichier avec le second USF et des explications, prends ton temps et analyses, il n'est certainement pas parfait mais des corrections pourront être apportées par les membres intéressé(e)s ou par d'autres observations.

Bonne nuit

[maxval18]

Bonjour Dom,

Je te remercie c'est nickel, je te souhaite une bonne journée

@+

Max

[maxval18]

Bonjour

Voila j'ai un USF pour faire la recherche CP, Ville, Arrondissement, Cantons ect... Qui m'a été réaliser par Dom "Casefayere" que je remercie beaucoup et que je salut au passage et si tu passe par ici et que tu as quelques minutes à m'accorder. J'aimerais finaliser mon code, j'ai associé les deux code ensemble.
Il marche très bien mais que dans un sens si je cherche le CP a l'aide de la Checkbox pas de problème si je cherche par la ville sa plante. J'ai du oublier quelque chose

Je vous remercie de l'aide que vous m'accorder

Cordialement
Max

[casefayere]

Re le forum, bonjour maxval18

...et si tu passe par ici et que tu as quelques minutes à m'accorder...

Eh non, figures-toi que je suis dans une m... terrible, (la journée), je suis en plein plantage, j'écris cette réponse d'un PC utilisé par un collègue. Je ne serai disponible que le soir, mais je suis persuadé qu'un mordu de DVP ou un des nombreux intervenants habituels pourra t'aider. Je ne manquerai pas de suivre ta discussion, le soir seulement.

Bonne journée et bon courage

[maxval18]

Bonjour Dom,

Je te remercie cas même d'avoir répondu c'est sympa et je te dis bon plantage.....

J'espere plus tard

Bonne journée

Max

[casefayere]

Bonsoir,
A l'origine, tu prenais les villes donc colonne A, je t'ai rétabli le code en ce sens,
si tu préfères les cantons, changes A pour K dans le code.
tu avais une plage qui allait jusque F, maintenant c'est K, j'ai donc aussi changé ça :

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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Private Sub ComboBox_ville_cp1_Change()
Dim ChoixFiltre As Integer, choix2 As String
Application.ScreenUpdating = False
Dim verif As Boolean
ComboBox_ville_cp2.Clear
With Sheets("Feuil1")
  If CheckBox1 Then
    ChoixFiltre = 1
    .Range("$A$1:$K$1").AutoFilter 'je mets le filtre automatique
    .Range("$A$1:$K$" & derlg).AutoFilter Field:=1, Criteria1:=ComboBox_ville_cp1
    tb2 = .Range("A2:I" & derlg).SpecialCells(xlCellTypeVisible)
    ComboBox_ville_cp2.AddItem tb2(1, 2)
    TextBox_dept = tb2(1, 3)
    TextBox_Region = tb2(1, 4)
    TextBox_Sp = tb2(1, 6)
    TextBox_Prefect = tb2(1, 5)
    TextBox1 = tb2(1, 7)
    TextBox2 = tb2(1, 8)
    TextBox3 = tb2(1, 9)
 
    .AutoFilterMode = False
  Else
    ChoixFiltre = 2
    If Len(ComboBox_ville_cp1) = 5 Then
      .Range("$A$1:$K$1").AutoFilter
      .Range("$A$1:$K$" & derlg).AutoFilter Field:=2, Criteria1:=ComboBox_ville_cp1
      tb2 = .Range("A2:K" & derlg).SpecialCells(xlCellTypeVisible)
      For x = 1 To UBound(tb2, 1)
        ComboBox_ville_cp2.AddItem tb2(x, 1)
      Next x
      TextBox_dept = tb2(1, 3)
      TextBox_Region = tb2(1, 4)
      TextBox_Sp = tb2(1, 6)
      TextBox_Prefect = tb2(1, 5)
        TextBox1 = tb2(1, 7)
        TextBox2 = tb2(1, 8)
        TextBox3 = tb2(1, 9)
 
      ComboBox_ville_cp2.ListIndex = 0
      .AutoFilterMode = False
    End If
  End If
  If Len(ComboBox_ville_cp1) = 5 Then
    verif = False
    For y = 1 To UBound(tb2, 1)
      If Str(tb2(y, 2)) = Str(ComboBox_ville_cp1) Then
        verif = True: Exit For
      End If
    Next y
    If verif = False Then
      MsgBox "aucune correspondance trouvée"
      ComboBox_ville_cp2.Value = "INCONNU"
      ComboBox_ville_cp2.Clear
      TextBox_dept = ""
      TextBox_Region = ""
      TextBox_Sp = ""
      TextBox_Prefect = ""
 
    End If
  End If
 
 
    .Range("$A$1:$K$" & derlg).AutoFilter Field:=ChoixFiltre, Criteria1:=ComboBox_ville_cp1 'je filtre sur ComboBox_ville_cp1
    If .Range("A2:A" & derlg).SpecialCells(xlCellTypeVisible).Rows.Count = 1 Then 'on vérifie que le résultat contient plus d'une ligne
      ListBoxVilles.AddItem .Range("A2:A" & derlg).SpecialCells(xlCellTypeVisible) 'sinon, on donne la ligne unique à la listbox
    Else
      tb2 = .Range("A2:A" & derlg).SpecialCells(xlCellTypeVisible) 'Je mets le résultat dans un tableau (cellules visibles)
      ListBoxVilles.list = tb2 'j'ai renommé la listbox "listboxvilles" et y insère les données du tableau
    End If
    .AutoFilterMode = False 'j'enlève le filtre
 
End With
 
'Nbre item dans la listbox
  Label6.Caption = "Il y a.." & ListBoxVilles.ListCount & "   " & "Ville dans le canton"
 
Application.ScreenUpdating = True
End Sub

Bonne soirée

[maxval18]

Bonjour DOM,

Et un grand merci d'avoir répondu,

Génial exactement la recherche, juste un bémol quand tu recherche dans le sens "CP vers ville" tu visualise bien les noms des cantons dans la listbox ainsi que les divers texbox tous marche nickel.
Dans l'autre sens c'est à dire "ville vers CP"les noms des cantons dans la listbox ne marche pas je pense qu'il y a du avoir un oubli.
Si le temps te le permet de donné un coup d'oeil........
Mais je te remercie beaucoup et te souhaite une bonne.

Cordialement

Max

[casefayere]

re le forum, bonjour maxval18

A l'origine, tu prenais les villes donc colonne A, je t'ai rétabli le code en ce sens,
si tu préfères les cantons, changes A pour K dans le code.

Il faut que tu répondes à cette question, après on adaptera, quoique je pense que tu aurais pu le faire seul, sinon je vais penser que tu ne comprends pas mes codes. Si c'est le cas, dis le et je mettrai les explications pas à pas (il faudra juste un peu de patience)

Bon courage

[maxval18]

Bonjour Dom

Je pense que l'on ne c'est pas compris. Quand je recherche un N° de code postal je rentre le nom de la ville Ex: Amareins j'ai CP qui s'affiche dans la Combobox puis les textbox Département, régions, S/Prefect et prefect ainsi que les arrondissements, Nbre de canton et Nbre de communes jusque la, tous va bien.
Dans la Listbox on devrait avoir affiché les villes du canton qui sont les suivantes:

"Saint-Loup-des-Chaumes
Saint-Symphorien
Serruelles
Uzay-le-Venon
Vallenay
Venesmes
Bonneval"

Qui je te l'accepte ne sont les bonnes communes mais pour l'exemple oui et dans la "textbox4" ont devrais avoir le chef lieu qui est "Crézançay-sur-Cher"

Alors pour le code j'ai fait ceci : peut être je me suis tromper ?

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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Private Sub ComboBox_ville_cp1_Change()
Dim ChoixFiltre As Integer, choix2 As String
Application.ScreenUpdating = False
Dim verif As Boolean
ComboBox_ville_cp2.Clear
With Sheets("Feuil1")
  If CheckBox1 Then
    ChoixFiltre = 1
    .Range("$A$1:$K$1").AutoFilter 'je mets le filtre automatique
    .Range("$A$1:$K$" & derlg).AutoFilter Field:=1, Criteria1:=ComboBox_ville_cp1
    tb2 = .Range("A2:I" & derlg).SpecialCells(xlCellTypeVisible)
    ComboBox_ville_cp2.AddItem tb2(1, 2)
    TextBox_dept = tb2(1, 3)
    TextBox_Region = tb2(1, 4)
    TextBox_Sp = tb2(1, 6)
    TextBox_Prefect = tb2(1, 5)
    TextBox1 = tb2(1, 7)
    TextBox2 = tb2(1, 8)
    TextBox3 = tb2(1, 9)
 
    .AutoFilterMode = False
  Else
    ChoixFiltre = 2
    If Len(ComboBox_ville_cp1) = 5 Then
      .Range("$A$1:$K$1").AutoFilter
      .Range("$A$1:$K$" & derlg).AutoFilter Field:=2, Criteria1:=ComboBox_ville_cp1
      tb2 = .Range("A2:K" & derlg).SpecialCells(xlCellTypeVisible)
      For x = 1 To UBound(tb2, 1)
        ComboBox_ville_cp2.AddItem tb2(x, 1)
      Next x
      TextBox_dept = tb2(1, 3)
      TextBox_Region = tb2(1, 4)
      TextBox_Sp = tb2(1, 6)
      TextBox_Prefect = tb2(1, 5)
        TextBox1 = tb2(1, 7)
        TextBox2 = tb2(1, 8)
        TextBox3 = tb2(1, 9)
 
      ComboBox_ville_cp2.ListIndex = 0
      .AutoFilterMode = False
    End If
  End If
  If Len(ComboBox_ville_cp1) = 5 Then
    verif = False
    For y = 1 To UBound(tb2, 1)
      If Str(tb2(y, 2)) = Str(ComboBox_ville_cp1) Then
        verif = True: Exit For
      End If
    Next y
    If verif = False Then
      MsgBox "aucune correspondance trouvée"
      ComboBox_ville_cp2.Value = "INCONNU"
      ComboBox_ville_cp2.Clear
      TextBox_dept = ""
      TextBox_Region = ""
      TextBox_Sp = ""
      TextBox_Prefect = ""
 
    End If
  End If
 
 
    .Range("$A$1:$K$" & derlg).AutoFilter Field:=ChoixFiltre, Criteria1:=ComboBox_ville_cp1 'je filtre sur ComboBox_ville_cp1
    If .Range("K2:K" & derlg).SpecialCells(xlCellTypeVisible).Rows.Count = 1 Then 'on vérifie que le résultat contient plus d'une ligne
      ListBoxVilles.AddItem .Range("K2:K" & derlg).SpecialCells(xlCellTypeVisible) 'sinon, on donne la ligne unique à la listbox
    Else
      tb2 = .Range("K2:K" & derlg).SpecialCells(xlCellTypeVisible) 'Je mets le résultat dans un tableau (cellules visibles)
      ListBoxVilles.list = tb2 'j'ai renommé la listbox "listboxvilles" et y insère les données du tableau
    End If
    .AutoFilterMode = False 'j'enlève le filtre
 
End With
 
'Nbre item dans la listbox
  Label6.Caption = "Il y a.." & ListBoxVilles.ListCount & "   " & "Ville dans le canton"
 
Application.ScreenUpdating = True
End Sub

@+

Max

[casefayere]

Bonsoir à tou(te)s, maxval18

Je t'envoie un fichier modifié sur lequel je vais travailler encore sur ta textbox "Chef lieu"
attention, il y a des changements avec le nom des textbox (c'est plus clair)

Bonne soirée

[casefayere]

eh bien, à force de travailler sur ton fichier, je m'aperçois des bugs prévisibles et les corrigent au fur et à mesure.

Il reste un problème et je ne sais pas si je pourrai le corriger :
- quand on choisit par ville, exemple "Brou", un seul code postal entre en combo2 alors que 2 "Brou" existent dans des régions différentes.
Le problème (je pense) vient du filtre sur + de 38000 lignes ou de "SpecialCells(xlCellTypeVisible)", je cherche encore mais la fatigue me gagne

Bonne nuit

Ci-dessous le fichier re-re-recorrigé

[maxval18]

Bonjour Dom,

Je te remercie beaucoup du travail réaliser vraiment super et je n'aurais jamais peut le faire moi même merci encore.
Je suis en train de finaliser mon proget j'ai ajouté une image "Blason" a chaque département avec se code:

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
Private Sub UserForm_Initialize()
  Set f = Sheets("photos")
  For Each s In f.Shapes
     Next
End Sub
 
'Photo département
Private Sub TextBox_dept_Change()
  Set s = f.Shapes(CStr(Me.TextBox_dept))
  s.CopyPicture 
  f.ChartObjects.Add(0, 0, s.Width, s.Height).Chart.Paste
  f.ChartObjects(1).Chart.Export Filename:="monimage.jpg"
  f.Shapes(f.Shapes.Count).Delete
  Me.Image1.PictureSizeMode = fmPictureSizeModeZoom
  Me.Image1.Picture = LoadPicture("monimage.jpg")
  Kill "monimage.jpg"
End Sub

Qui marche trés bien mais si je change ma Checkbox j'ai un message d'erreur
"Erreur définie par l'application ou par l'objet"
sur "s.CopyPicture"
Peut être tu as une idée

Je te souhaite une tres bonne journée
Et merci pour le temps passer sur mon code

@+
Max

[casefayere]

Bonjour à tou(te)s, maxval18,

envoies le fichier modifié et je regarderai ce soir (impossible avant)

A ce soir

[maxval18]

Re,

Voila j'ai mis toutes les explication sur la 1er onglet

Merci beaucoup

@+

Max

[casefayere]

Bonjour le forum, maxval18

Je viens d'essayer, pour l'instant il est normal que tu te retrouve avec des bigs car tu n'as que 2 blasons donc tu peux te retrouver avec e message ci-dessous si tu selectionnes un code postal auquel aucune image n'est associée. D'autre part, un détail mais qui pour moi a de l'importance; il faut déclarer tes variables de façon explicite :
non

Code :

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

Dim f  'Photo

mais

Code :

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

Dim f As Worksheet 'Photo

A +

[maxval18]

Bonjour Dom,

J'ai bien changer mes variables comme tu me le signaler

Code :

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

Dim f As Worksheet

j'ai rajouter 15 Blasons de plus puisque sa représente uniquement les départements du "TextBox_dept" et rien de mieux.

Ex. Si je rentre dans la "ComboBox_ville_cp1" 01000 tous va marcher nickel ainsi que le Blasons du département si après je click sur la Checkbox pour changer et rechercher une ville la message d'erreur.....

Je te souhaite une bonne journée

@+

Max

[casefayere]

Bonjour le forum, Max,

Déjà, une chose, quand je t'ai dit :

il faut déclarer tes variables de façon explicite :

Il fallait traduire (comme on me l'a rappelé) :
Je préfère déclarer les variables avec leur type
Mais j'espère que tu m'aura compris.

Pour revenir à ton problème,
Essayes comme ça :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub TextBox_dept_Change()
  If TextBox_dept <> "" Then
  On Error Resume Next
  Set s = f.Shapes(CStr(Me.TextBox_dept))
  s.CopyPicture
  f.ChartObjects.Add(0, 0, s.Width, s.Height).Chart.Paste
  f.ChartObjects(1).Chart.Export Filename:="monimage.jpg"
  f.Shapes(f.Shapes.Count).Delete
  Me.Image1.PictureSizeMode = fmPictureSizeModeZoom
  Me.Image1.Picture = LoadPicture("monimage.jpg")
  Kill "monimage.jpg"
  End If
End Sub