code vba excel

Version imprimable

code vba excel

Bonjour tout le monde j’ai vraiment besoin de votre aide SVP je suis novice en vba
J’ai un Userform avec une listbox multi colonne qui affiche les détails des clients, des textbox , combobox et trois bouton, je mit le code a votre disposition que j’ai utilisé il fonction bien, mon problème si avec la textbox1 « N° Client » elle ce rempli en chiffre 1,2,3… les N° Client, se que je veut que la textbox1 « N° Client » ce rempli de cette manière « CLT-1, CLT-2, CLT-3… » A chaque nouveau enregistrement, pour info j’ai une textbox que j’ai nommé Nbrligne elle affiche le nombre de ligne enregistré sur la feuil « Client » elle es en relation avec la textbox1
Et merci d’avance

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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
Option Compare Text
Dim f, CL(), ListeVille(), LigneEnreg
 
Private Sub B_nouveau_Click()
  razChampForm
  LigneEnreg = f.[A65000].End(xlUp).Row + 1
  Me.TextBox1 = f.Cells(LigneEnreg - 1, 1) + 1
  Me. Nbrligne = LigneEnreg
  Me.TextBox1.SetFocus
End Sub
Sub razChampForm()
 For Each k In Array(1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 12)
      Me("textbox" & k) = ""
 Next
 Me.ComboBox2 = ""
 Me.ComboBox3 = ""
End Sub
 
 
Private Sub TextBox13_Change()
razChampForm
On Error Resume Next
With Sheets("Client").[A1].CurrentRegion
  .Parent.ShowAllData
  If TextBox13 <> "" Then .AutoFilter 2, TextBox13 & "*"
  If TextBox14 <> "" Then .AutoFilter 12, "*" & TextBox14 & "*"
  .Copy Feuil1.[A1] 'vers la feuille auxiliaire
  ListBox1.Clear
  With Feuil1.[A1].CurrentRegion
    ListBox1.List = .Offset(1).Resize(.Rows.Count - 1).Value
    .Clear 'RAZ
  End With
  .Parent.ShowAllData
End With
End Sub
 
Private Sub TextBox14_Change()
TextBox13_Change
End Sub
 
Private Sub UserForm_Initialize()
  Dim cw$
cw = "20;50;50;90;50;50;50;50;50;50;50;50;40" 'largeurs à adapter
ListBox1.ColumnWidths = cw
 
  Set f = Sheets("Client")
  If f.[B2] = "" Then Exit Sub
  CL = f.Range("a2:m" & [A65000].End(xlUp).Row).Value
  ListeVille = Range("villecodepostal").Value
  Me.ComboBox2.List = ListeVille
  Me.ComboBox3.List = Array("Bon", "Mauvais")
  For i = 1 To UBound(CL, 2) - 1
   largeur = largeur + f.Columns(i).Width * 1
  Next
  Me.ListBox1.List = CL 
 End Sub
 
Private Sub ListBox1_Click()
  Ligne = ListBox1.ListIndex
  For Each i In Array(1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 12)
      Me("textbox" & i) = ListBox1.List(Ligne, i - 1)
  Next i
  Me.ComboBox2 = ListBox1.List(Ligne, 5)
   Me.ComboBox3 = ListBox1.List(Ligne, 12)
   reservation = Me.TextBox1
  Set result = f.[A:A].Find(what:=reservation)
  If Not result Is Nothing Then
    LigneEnreg = result.Row
    Me. Nbrligne = LigneEnreg
  Else
    MsgBox "Erreur no réservation"
  End If
End Sub
 
Private Sub ComboBox2_Change()
 On Error Resume Next
 If ActiveControl.Name <> "ComboBox2" Then Exit Sub
 On Error GoTo 0
 If Me.ComboBox2.ListIndex = -1 And _
     IsError(Application.Match(Me.ComboBox2, Application.Index(ListeVille, , 1), 0)) Then
     Dim b()
     Me.TextBox5 = ""
     clé = UCase(Me.ComboBox2) & "*"
     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.ComboBox2.List = Application.Transpose(b)
        Me.ComboBox2.RemoveItem n
      End If
      Me.ComboBox2.DropDown
   Else
      On Error Resume Next
      Me.TextBox5 = Me.ComboBox2.Column(1)
   End If
End Sub
 
Private Sub B_suppression_Click()
 If MsgBox("Etes vous sûr?", vbYesNo) = vbYes Then
  If LigneEnreg <> 0 Then
    Rows(LigneEnreg).Delete
    CL = f.Range("a2:m" & [A65000].End(xlUp).Row).Value
    TextBox13_Change
  End If
 End If
End Sub
 
Private Sub B_valider_Click()
  If Me.TextBox1 = "" Then
    MsgBox "Saisir un N° Client"
    Me.TextBox1.SetFocus
    Exit Sub
 End If
 If Not IsDate(Me.TextBox12) Then
    MsgBox "Saisir une Date!"
    Me.TextBox12.SetFocus
    Exit Sub
 End If
 If Me. Nbrligne <> 0 And Me.TextBox1 <> "" And LigneEnreg <> 0 Then
   lig = LigneEnreg
   For Each k In Array(1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 12)
     tmp = Me("textbox" & k)
     If IsNumeric(tmp) Then
        f.Cells(lig, k) = CDbl(tmp)
     Else
        If IsDate(f.Cells(lig, k)) Then
           f.Cells(lig, k) = CDate(tmp)
        Else
           f.Cells(lig, k) = tmp
        End If
     End If
   Next
   f.Cells(lig, 6) = Me.ComboBox2
   f.Cells(lig, 13) = Me.ComboBox3
   Ligne = ListBox1.ListIndex
   bd = f.Range("a2:m" & [A65000].End(xlUp).Row).Value
   TextBox13_Change
   Me.ListBox1.ListIndex = Ligne
   razChampForm
 End If
End Sub

13/06/2016, 01h31
clementmarcotte

Bonjour,

S.V.P. Peut-être un petit tour par là, qui serait universellement apprécié pour faciliter la vie des gens qui vont devoir lire et comprendre ton code:

http://club.developpez.com/aidenouve...es/Balises.gif

Une chose que pourrais (devrais) faire, c'est de mettre toutes tes lignes On error en commentaires, un point d'arrêt avant ton TextBox qui cause problème et faire bout au pas-à-pas en regardant ta feuille Excel après chaque ligne. Des fois, c'est magique

ce code ne cause aucun problème
je voudrais juste changé le remplissage de la textbox1 a chaque nouveau enregistrement qui es en chiffre par Clt-1,Clt-2 ...

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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
Option Compare Text
Dim f, CL(), ListeVille(), LigneEnreg
 
Private Sub B_nouveau_Click()
razChampForm
LigneEnreg = f.[A65000].End(xlUp).Row + 1
Me.TextBox1 = f.Cells(LigneEnreg - 1, 1) + 1
Me. Nbrligne = LigneEnreg
Me.TextBox1.SetFocus
End Sub
Sub razChampForm()
For Each k In Array(1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 12)
Me("textbox" & k) = ""
Next
Me.ComboBox2 = ""
Me.ComboBox3 = ""
End Sub
 
 
Private Sub TextBox13_Change()
razChampForm
On Error Resume Next
With Sheets("Client").[A1].CurrentRegion
.Parent.ShowAllData
If TextBox13 <> "" Then .AutoFilter 2, TextBox13 & "*"
If TextBox14 <> "" Then .AutoFilter 12, "*" & TextBox14 & "*"
.Copy Feuil1.[A1] 'vers la feuille auxiliaire
ListBox1.Clear
With Feuil1.[A1].CurrentRegion
ListBox1.List = .Offset(1).Resize(.Rows.Count - 1).Value
.Clear 'RAZ
End With
.Parent.ShowAllData
End With
End Sub
 
Private Sub TextBox14_Change()
TextBox13_Change
End Sub
 
Private Sub UserForm_Initialize()
Dim cw$
cw = "20;50;50;90;50;50;50;50;50;50;50;50;40" 'largeurs à adapter
ListBox1.ColumnWidths = cw
 
Set f = Sheets("Client")
If f.[B2] = "" Then Exit Sub
CL = f.Range("a2:m" & [A65000].End(xlUp).Row).Value
ListeVille = Range("villecodepostal").Value
Me.ComboBox2.List = ListeVille
Me.ComboBox3.List = Array("Bon", "Mauvais")
For i = 1 To UBound(CL, 2) - 1
largeur = largeur + f.Columns(i).Width * 1
Next
Me.ListBox1.List = CL
End Sub
 
Private Sub ListBox1_Click()
Ligne = ListBox1.ListIndex
For Each i In Array(1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 12)
Me("textbox" & i) = ListBox1.List(Ligne, i - 1)
Next i
Me.ComboBox2 = ListBox1.List(Ligne, 5)
Me.ComboBox3 = ListBox1.List(Ligne, 12)
reservation = Me.TextBox1
Set result = f.[A:A].Find(what:=reservation)
If Not result Is Nothing Then
LigneEnreg = result.Row
Me. Nbrligne = LigneEnreg
Else
MsgBox "Erreur no réservation"
End If
End Sub
 
Private Sub ComboBox2_Change()
On Error Resume Next
If ActiveControl.Name <> "ComboBox2" Then Exit Sub
On Error GoTo 0
If Me.ComboBox2.ListIndex = -1 And _
IsError(Application.Match(Me.ComboBox2, Application.Index(ListeVille, , 1), 0)) Then
Dim b()
Me.TextBox5 = ""
clé = UCase(Me.ComboBox2) & "*"
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.ComboBox2.List = Application.Transpose(b)
Me.ComboBox2.RemoveItem n
End If
Me.ComboBox2.DropDown
Else
On Error Resume Next
Me.TextBox5 = Me.ComboBox2.Column(1)
End If
End Sub
 
Private Sub B_suppression_Click()
If MsgBox("Etes vous sûr?", vbYesNo) = vbYes Then
If LigneEnreg <> 0 Then
Rows(LigneEnreg).Delete
CL = f.Range("a2:m" & [A65000].End(xlUp).Row).Value
TextBox13_Change
End If
End If
End Sub
 
Private Sub B_valider_Click()
If Me.TextBox1 = "" Then
MsgBox "Saisir un N° Client"
Me.TextBox1.SetFocus
Exit Sub
End If
If Not IsDate(Me.TextBox12) Then
MsgBox "Saisir une Date!"
Me.TextBox12.SetFocus
Exit Sub
End If
If Me. Nbrligne <> 0 And Me.TextBox1 <> "" And LigneEnreg <> 0 Then
lig = LigneEnreg
For Each k In Array(1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 12)
tmp = Me("textbox" & k)
If IsNumeric(tmp) Then
f.Cells(lig, k) = CDbl(tmp)
Else
If IsDate(f.Cells(lig, k)) Then
f.Cells(lig, k) = CDate(tmp)
Else
f.Cells(lig, k) = tmp
End If
End If
Next
f.Cells(lig, 6) = Me.ComboBox2
f.Cells(lig, 13) = Me.ComboBox3
Ligne = ListBox1.ListIndex
bd = f.Range("a2:m" & [A65000].End(xlUp).Row).Value
TextBox13_Change
Me.ListBox1.ListIndex = Ligne
razChampForm
End If
End Sub