Modification d'un code VBA

Version imprimable

1 pièce(s) jointe(s)

Bonjour
J'ai un formulaire qui fonctionne très mais j'aimerai lui apporter un modification, j'aimerai si possible supprimer la listBox qu'il y a dans le UsF_Recherche et lorsque je rentre un nom de département soit manuellement soit automatiquement dans la TxtB_Recherche et que je clique a l'intérieur sa m'ouvre UsF_Resultat sinon le principe et excellent.

Je Vous remercie d'avance et te souhaite une bonne soirée
Mon code

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
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
79
80
81
82
83
UserForm2.Show
End Sub
 
Private Sub LstB_Recherche_Click()
With UsF_Recherche
  With .LstB_Recherche
 Lgn = .List(.ListIndex, 1)
 
  End With
Unload Me
End With
With UsF_Resultat
 With .TxtB_Departement
      .Value = ""
      .Text = Tab_Source(Lgn, 1)
 End With
 With .TxtB_Chef_Lieux
      .Value = ""
      .Text = Tab_Source(Lgn, 2)
 End With
 
 With .TxtB_Arrondissement
      .Value = ""
      .Text = Tab_Source(Lgn, 3)
 End With
 With .TxtB_Cantons
      .Value = ""
       .Text = Tab_Source(Lgn, 4)
 End With
 With .TxtB_Communes
      .Value = ""
      .Text = Tab_Source(Lgn, 5)
 End With
 With .TxtB_Populations
      .Value = ""
      .Text = Tab_Source(Lgn, 6)
 End With
 With .TxtB_Densite
      .Value = ""
      .Text = Tab_Source(Lgn, 7)
 End With
 With .TxtB_Superficie
      .Value = ""
      .Text = Tab_Source(Lgn, 8)
 End With
 .Show
End With
End Sub
 
Private Sub TxtB_Recherche_Change()
x = 0 'on initialise à 0
Str_Search = "" 'on vide la variable
Erase Tab_Recherche 'on vide le tableau
With UsF_Recherche 'avec le Userform
     .LstB_Recherche.Clear 'on efface la ListBox
 Str_Search = UCase(.TxtB_Recherche.Text) 'on récupére la valeur du TextBox(en minuscule)
  If Str_Search = "" Then Exit Sub 'si la variable texte est vide on quitte
For Lgn = 1 To UBound(Tab_Source, 1) 'pour chaque ligne du tableau source
  If UCase(Tab_Source(Lgn, 1)) Like UCase(Str_Search) & "*" Then ' si correspondance
    ReDim Preserve Tab_Recherche(2, x) 'on redimmensionne le tableau Recherche
       Tab_Recherche(0, x) = Tab_Source(Lgn, 1) 'on entre la valeur de la premiere colonne du tableau source
       Tab_Recherche(1, x) = Lgn 'on entre la reference a la ligne ou se trouve la valeur trouvee
       x = x + 1 'on incremente
  End If
Next Lgn 'autre ligne
End With
If x = 0 Then Exit Sub 'si pas de resultat on quitte
UsF_Recherche.LstB_Recherche.Column = Tab_Recherche()
End Sub
 
Private Sub UserForm_Initialize()
Set Ws_Source = Worksheets("Départements") 'on initialise la variable feuille
With Ws_Source 'avec cette feuille
    DerLgn = .Cells(.Rows.Count, 3).End(xlUp).Row 'on determine la derniere ligne non vide de la colonne 3(C)
Tab_Source = .Range(.Cells(1, 3), .Cells(DerLgn, 10)).Value 'on récupé"re dans le tab_Source les valeur de la plage ainsi définie
End With
With UsF_Recherche 'avec le Userform
  With .LstB_Recherche 'avec la ListBox
       .ColumnCount = 2 'on formate a 2 colonne
       .ColumnWidths = "213;0" 'une visible(Departement) l'autre non(reference a la ligne dans le tableau)
  End With
End With
End Sub

Je vous joins mon exemple qui seras plus explicite.

Merci D'avance

Cordialement

Max

13/07/2014, 10h23
Daniel.C

Bonjour,

Pourquoi conserver UsF_Recherche ?
13/07/2014, 18h32
maval18

Bonjour Daniel

Est merci d'avoir répond.

Citation:

Pourquoi conserver UsF_Recherche ?

Parce que a l'origine il y a une carte de france créer en Chappe qui ouvre un formulaire qui se nome UsF_Recherche et dans le textbox nommer "TxtB_Recherche" il y a un nom de département et j'aimerai que lorsque je clique dans le textBox "TxtB_Recherche" il m'ouvre le'UserForm UsF_Resultat avec tous les textbox rempli a l'aide de la feuille nommer Département.

J'espère avoir était assez explicite sinon je me tiens a ta disposition

Cordialement

Max

1 pièce(s) jointe(s)

Une fois le textbox rempli, il faut faire un double-clic dedans. Voici le code (j'ai limité les modifs au minimum) :

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
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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
'Appel par textbox
Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
 
UserForm2.Show
End Sub
 
Private Sub LstB_Recherche_Click()
With UsF_Recherche
  With .LstB_Recherche
 Lgn = .List(.ListIndex, 1)
 
  End With
Unload Me
End With
With UsF_Resultat
 With .TxtB_Departement
      .Value = ""
      .Text = Tab_Source(Lgn, 1)
 End With
 With .TxtB_Chef_Lieux
      .Value = ""
      .Text = Tab_Source(Lgn, 2)
 End With
 
 With .TxtB_Arrondissement
      .Value = ""
      .Text = Tab_Source(Lgn, 3)
 End With
 With .TxtB_Cantons
      .Value = ""
       .Text = Tab_Source(Lgn, 4)
 End With
 With .TxtB_Communes
      .Value = ""
      .Text = Tab_Source(Lgn, 5)
 End With
 With .TxtB_Populations
      .Value = ""
      .Text = Tab_Source(Lgn, 6)
 End With
 With .TxtB_Densite
      .Value = ""
      .Text = Tab_Source(Lgn, 7)
 End With
 With .TxtB_Superficie
      .Value = ""
      .Text = Tab_Source(Lgn, 8)
 End With
 .Show
End With
End Sub
 
 
Private Sub TxtB_Recherche_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Lgn = Application.Match(Me.TxtB_Recherche, [Départements!C:C], 0)
    Unload UsF_Recherche
    If IsNumeric(Lgn) Then
        With UsF_Resultat
         With .TxtB_Departement
              .Value = ""
              .Text = Sheets("Départements").Cells(Lgn, 3)
         End With
         With .TxtB_Chef_Lieux
              .Value = ""
              .Text = Sheets("Départements").Cells(Lgn, 4)
         End With
 
         With .TxtB_Arrondissement
              .Value = ""
              .Text = Sheets("Départements").Cells(Lgn, 5)
         End With
         With .TxtB_Cantons
              .Value = ""
               .Text = Sheets("Départements").Cells(Lgn, 6)
         End With
         With .TxtB_Communes
              .Value = ""
              .Text = Sheets("Départements").Cells(Lgn, 7)
         End With
         With .TxtB_Populations
              .Value = ""
              .Text = Sheets("Départements").Cells(Lgn, 8)
         End With
         With .TxtB_Densite
              .Value = ""
              .Text = Sheets("Départements").Cells(Lgn, 9)
         End With
         With .TxtB_Superficie
              .Value = ""
              .Text = Sheets("Départements").Cells(Lgn, 10)
         End With
         .Show
        End With
    End If
End Sub

Pièce jointe 151095

13/07/2014, 20h26
maval18

RE,

Je te remercie Nickel

Bonne soirée

Max