Discussion :

[jean30]

Bonjour à chacun de vous
Je ne sais pas si c'est possible, mais je voudrai qu'à l'affichage du Userform lors de la sélection dans Listbox
que les Textbox 3 - 4 - 5 - 14 - 15 - 16 - 17 ne se remplissent pas mais permettent la saisie pour ajouter - modifier la base
En vous remerciant

[Transitoire]

Bonjour,
C'est pas clair du tout?
A l'ouverture d'un userform, les textBoxs sont a priori vides. Puisque l'intérêt est de pouvoir y écrire dedans. Bien sur on peut aussi y prévoir quelque chose par défaut, mais ça impose de coder.
Si vous avez des macros ou des codes, copiez les afin que l'on puisse les voir.
Merci
Cordialement

[jean30]

Bonsoir Transitoire et merci de t'intéresser à ma demande
Voici les codes :

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
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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
Option Base 1
Public NbCol 'initialisée dans chargerListBox1: determine le nb de colonnes dans le ListBox
Public EvenAuto As Boolean
 
'controles de format de saisie
Private Sub tb6_Change() 'Téléphone Maison
Dim Valeur As Byte
     tb6.MaxLength = 14 'nb caracteres maxi dans textbox
Valeur = Len(tb6)
     If Valeur = 2 Or Valeur = 5 Or Valeur = 8 Or Valeur = 11 Then tb6 = tb6 & " " 'ajoute automatiquement un espace entre les numéros
 
End Sub
Private Sub tb6_KeyPress(ByVal Touche As MSForms.ReturnInteger)
     If InStr("0123456789", Chr(Touche)) = 0 Then Touche = 0 'si on tape autre chose qu'un chiffre, il est annulé
End Sub
 
Private Sub tb7_Change() 'Téléphone Portable
Dim Valeur As Byte
     tb7.MaxLength = 14 'nb caracteres maxi dans textbox
Valeur = Len(tb7)
     If Valeur = 2 Or Valeur = 5 Or Valeur = 8 Or Valeur = 11 Then tb7 = tb7 & " " 'ajoute automatiquement un espace entre les numéros
End Sub
 
Private Sub tb7_KeyPress(ByVal Touche As MSForms.ReturnInteger)
      If InStr("0123456789", Chr(Touche)) = 0 Then Touche = 0 'si on tape autre chose qu'un chiffre, il est annulé
End Sub
 
Private Sub tb8_Change() 'Téléphone Bureau
Dim Valeur As Byte
tb8.MaxLength = 14 'nb caracteres maxi dans textbox
Valeur = Len(tb8)
     If Valeur = 2 Or Valeur = 5 Or Valeur = 8 Or Valeur = 11 Then tb8 = tb8 & " " 'ajoute automatiquement un espace entre les numéros
End Sub
 
Private Sub tb8_KeyPress(ByVal Touche As MSForms.ReturnInteger)
     If InStr("0123456789", Chr(Touche)) = 0 Then Touche = 0 'si on tape autre chose qu'un chiffre, il est annulé
End Sub
 
Private Sub tb3_Change()
Dim Valeur As Byte
tb3.MaxLength = 10 'nb caracteres maxi dans textbox
Valeur = Len(tb3)
     If Valeur = 2 Or Valeur = 5 Then tb3 = tb3 & "/" 'ajoute automatiquement les séparateurs de la date "/"
          If Len(Me.tb3.Value) = 10 And IsDate(Me.tb3.Value) Then 'si on a bien saisi une date
              If Year(Me.tb3.Value) > Year(Date) Then 'si elle est après la date d'aujourd'hui, on ne met rien dans la boite Age
              Me.tb3 = "": Me.TbAge = ""
              Exit Sub
     End If
          Me.tb3 = Trim(Format(Me.tb3, "dd/mm/yyyy"))
          Me.TbAge = DateDiff("yyyy", Trim(CDate(Me.tb3)), Date)
     ElseIf Len(Me.tb3) = 10 And Not IsDate(Me.tb3.Value) Then
         Me.tb3 = "": Me.TbAge = ""
     Else
         Me.TbAge = ""
     End If
End Sub
 
Private Sub tb3_KeyPress(ByVal Touche As MSForms.ReturnInteger)
     If InStr("0123456789", Chr(Touche)) = 0 Then Touche = 0 'si on tape autre chose qu'un chiffre, il est annulé
End Sub
 
Private Sub UserForm_Initialize() 'initialise les élements du USF à son ouverture
    EvenAuto = False
    chargerListBox1 'on charge la ListBox avec les infos de la base
    'on initialise le Combobox avec oui et non
    tb18.AddItem "oui"
    tb18.AddItem "non"
    Me.B_valid.Caption = "Modifier"
    EvenAuto = True
End Sub
 
Private Sub B_efface_Click() 'au clic bouton "ANNULER" on efface les TB
'ou on peut recharger les infos du nom sélectionné?
'ChargerData
For i = 1 To 21 '21= Nb de TB dans le formulaire
     Me.Controls("tb" & i) = ""
Next i
ListBox1.ListIndex = -1 'on déselectionne pour eviter de supprimer une ligne en cas de clic sur bouton "SUPPRIMER"
End Sub
 
Private Sub B_sup_Click() 'au clic bouton "SUPPRIMER" on supprime le nom sélectioné de la base
With Sheets("Base")
Set c = .Range("A:A").Find(ListBox1.Value) 'on cherche son emplacement ! si doublon. c'est le premier trouvé qui sera supprimé
      If Not c Is Nothing Then
           c.EntireRow.Delete
      End If
    chargerListBox1 'recharger la listebox mise à jour
    ListBox1.ListIndex = -1 'on déselectionne pour eviter de supprimer une ligne en cas de clic sur bouton "SUPPRIMER"
End With
End Sub
 
Private Sub B_valid_Click() 'au clic bouton "VALIDER / MODIFIER" on valide la modification et on les enregistre dans la base
If tb1 = "" Then Exit Sub
With Sheets("Base")
    Set c = .Range("A:A").Find(tb1, Lookat:=xlWhole) 'on cherche son emplacement ! si doublon. c'est le premier trouvé qui sera modifié
    If Not c Is Nothing Then
        For i = 1 To 21 '21= Nombre de TB dans le formulaire
            c.Offset(0, i - 1) = Me.Controls("tb" & i)
        Next i
        For i = 6 To 8 'pour les textbox de numéro de téléphone on met le format
            c.Offset(0, i - 1) = Format(c.Offset(0, i - 1), "0# ## ## ## ##")
        Next i
 
    Else 'on a sans doute modifié le nom. donc proposer d'en créer un nouveau
        Nouveau = MsgBox("Souhaitez vous créer ce nouveau nom: " & tb1 & " ?", vbYesNo)
        If Nouveau = 6 Then
            CreerContact
            GoTo fin
        Else
            EvenAuto = False
            Call B_efface_Click
            EvenAuto = True
            GoTo fin
        End If
    End If
    c.Offset(0, 21) = Format(Now, "dd/mm/yyyy") 'mise à jour de la date de Mise à jour en colonne V
End With
fin:
chargerListBox1 'recharger la listebox mise à jour
ListBox1.ListIndex = -1 'on déselectionne pour eviter de supprimer une ligne en cas de clic sur bouton "SUPPRIMER"
'B_valid.Caption = "Modifier" 'on change le texte du bouton Valider -->Modifier
Vérifier
End Sub
 
Private Sub B_Quitter_Click() 'au clic bouton "QUITTER" on quitte l'USF
Unload Me
End Sub
 
Private Sub ListBox1_Click() 'lors de la selection d'un nom dans la Listebox, on charge les data
    EvenAuto = False
    ChargerData
    EvenAuto = True
End Sub
 
Sub chargerListBox1() 'on charge la ListBox avec les infos de la feuille Base
ListBox1.Clear 'on efface la listbox
Dim Tbl() 'on déclare un tablo NON dimensionné
'on définit le nombre de colonnes et leur taille
NbCol = 22
ListBox1.ColumnCount = NbCol
ListBox1.ColumnWidths = "90;80" 'largeur des colonnes
 
With Sheets("Base")
    NbContacts = .Range("A" & .Rows.Count).End(xlUp).Row - 1 'récupère le nombre de contacts (pas de distinction en cas de doublons! )
 
    ReDim Tbl(NbContacts, NbCol) 'on dimensionne le tablo de NbContacts lignes et NbCol colonnes
    For i = 1 To NbContacts 'on remplit le tablo avec les éléements de la feuille Base
        For j = 1 To NbCol
            Tbl(i, j) = .Cells(i + 1, j)
        Next j
    Next i
 
    'NOTA: il y a surement plus rapide en faisant un set tbl=.range("A2").resize(NbContacts,NbCol).value
   Me.ListBox1.List = Tbl 'on charge la ListBox avec le contenu de Tbl
   Enreg = NbContacts 'mise à jour du compteur de contacts en bas à droite de la Listbox
End With
End Sub
 
Sub ChargerData() 'lors de la sélection d'un nom dans la ListBox, on va cherchre les infos dans la feuille Base pour de remplir les TB
With Sheets("Base")
    Set c = .Range("A:A").Find(ListBox1.Column(0)) 'on cherche l'emplacement dans la base
    If Not c Is Nothing Then
        For i = 1 To 21
            Me.Controls("tb" & i) = c.Offset(0, i - 1)
         Next i
         For i = 6 To 8 'pour les textbox de numéro de téléphone on met le format
            Me.Controls("Tb" & i) = Format(Me.Controls("Tb" & i), "0# ## ## ## ##")
        Next i
    End If
End With
'Mise à jour de l'age
Me.TbAge = DateDiff("yyyy", Me.Controls("tb3"), Now)
End Sub
 
Private Sub TrieretVérifier()       'Appelé à quel moment - Où ???
    Call Trier
    Call Vérifier
    Call Tiret
End Sub
 
Sub Trier()     'tri sur la colonne A (Nom) et Colonne B (Prénom)
    Dim DerL&, Lig&
    DerL = Sheets("Base").Range("A" & Rows.Count).End(xlUp).Row
    Feuil3.Range("A2:Z" & DerL).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2")
End Sub
 
Sub Vérifier()     'vérifie qu'il y a un CP et une adresse
    Dim DerL&, Lig&
    DerL = Sheets("Base").Range("A" & Rows.Count).End(xlUp).Row
    For Lig = 2 To DerL
        If Cells(Lig, 12) = "" And Cells(Lig, 10) <> "" Then 'si Code Postal (col L) est vide ET Adresse (Col J) non vide
            With Cells(Lig, 12)
                .Value = "Non communiquée"
                .Font.Bold = True
                .Font.ColorIndex = 3
            End With
        Else
     End If
    Next Lig
    Cells.Columns.AutoFit
    Range("A1").Select
    Tiret
End Sub
 
Sub Tiret()      'remplace les cellules vides des colonnes F à I par un tiret
Dim O As Worksheet      'déclare la variable O (Onglet)
Dim DL As Long      'déclare la variable DL (Dernière Ligne)
Dim CEL As Range      'déclare la variable CEL (CELlule)
 
Set O = Worksheets("Base")      'définit l'onglet O (à adapter à ton code)
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row      'définit la dernière ligne éditée DL de la colonne A de l'onglet O
For Each CEL In Range("F2:I" & DL)      'boucle sur toutes les cellules CEL de la plage F1:H...
   If CEL.Value = "" Then CEL.Value = "'-"      'si la cellule est vide, écrit un tiret dans la cellule
Next CEL      'prochaine cellule de la boucle
End Sub
 
Private Sub Imprimer_Click()
Me.PrintForm
End Sub
Sub CreerContact()
    If Me.Controls("Tb2").Value = "" Then
        MsgBox ("Veuillez saisir un prénom avant de continuer")
        Exit Sub
    End If
    With Sheets("Base")
        Set c = .Range("A:A").Find(tb1, Lookat:=xlWhole)
        If Not c Is Nothing Then
            MsgBox ("Attention ! Ce Nom existe déjà")
            Exit Sub
        Else
            FinBase = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            For i = 1 To 21
                .Range("A" & FinBase).Offset(0, i - 1) = Me.Controls("Tb" & i)
 
                Select Case i 'un peu de mise en forme
                    Case 1 'Majuscule et gras
                        .Range("A" & FinBase).Offset(0, i - 1) = UCase(.Range("A" & FinBase).Offset(0, i - 1)) 'mise en majuscule du NOM
                        .Range("A" & FinBase).Offset(0, i - 1).Font.Bold = True 'mise en Gras du NOM
                    Case 2, 4, 10, 11, 13, 14, 15, 16, 17 'Majuscule
                        .Range("A" & FinBase).Offset(0, i - 1).Font.Bold = True
                        .Range("A" & FinBase).Offset(0, i - 1) = WorksheetFunction.Proper(.Range("A" & FinBase).Offset(0, i - 1))
                    Case 3
                        .Range("A" & FinBase).Offset(0, i - 1) = Format(.Range("A" & FinBase).Offset(0, i - 1), "dd/mm/yyyy")
                    Case 6, 7, 8
                        .Range("A" & FinBase).Offset(0, i - 1) = Format(.Range("A" & FinBase).Offset(0, i - 1), "0# ## ## ## ##")
                    Case 9
                        'format adresse mail ?
                    Case 12
                        .Range("A" & FinBase).Offset(0, i - 1) = Format(.Range("A" & FinBase).Offset(0, i - 1), "#####")
                End Select
 
            Next i
 
            .Range("A" & FinBase).Offset(0, 21) = Format(Now, "dd/mm/yyyy") 'mise à jour de la date de Mise à jour en colonne V
            'ChargerData
        End If
    End With
    Me.B_valid.Caption = "Modifier"
End Sub
 
Private Sub tb1_Change()
    If EvenAuto = True Then Me.B_valid.Caption = "Valider"
End Sub
 
Private Sub tb2_Change()
    If EvenAuto = True Then Me.B_valid.Caption = "Valider"
End Sub
 
'Sub AgeUpdate()
'If Me.Controls("tb3") <> "" And (Len(Me.Controls("tb3")) = 10) Then
'    Me.TbAge = DateDiff("yyyy", Me.Controls("tb3"), Now)
'Else
'    Me.TbAge = ""
'End If
'End Sub

[Transitoire]

Bonjour, Ci dessous l'endroit dans le code ou le programme charge les textboxs(En rouge)

Sub ChargerData() 'lors de la sélection d'un nom dans la ListBox, on va cherchre les infos dans la feuille Base pour de remplir les TB
With Sheets("Base")
Set c = .Range("A:A").Find(ListBox1.Column(0)) 'on cherche l'emplacement dans la base
If Not c Is Nothing Then
For i = 1 To 21
Me.Controls("tb" & i) = c.Offset(0, i - 1)
Next i
For i = 6 To 8 'pour les textbox de numéro de téléphone on met le format
Me.Controls("Tb" & i) = Format(Me.Controls("Tb" & i), "0# ## ## ## ##")
Next i
End If
End With

Compte tenu du peu d'éléments dont je dispose je propose cette modification:

Set c = .Range("A:A").Find(ListBox1.Column(0)) 'on cherche l'emplacement dans la base
If Not c Is Nothing Then
For i = 1 To 2
Me.Controls("tb" & i) = c.Offset(0, i - 1)
Next i
For i = 6 To 13
Me.Controls("tb" & i) = c.Offset(0, i -1)
Next i
For i = 6 To 8 'pour les textbox de numéro de téléphone on met le format
Me.Controls("Tb" & i) = Format(Me.Controls("Tb" & i), "0# ## ## ## ##")
Next i
End If
End With

Ne pouvant vérifier, j'ai mis le rajout en vert, car c'est la couleur de l'espérance.
Vous pouvez essayer avec un dossier de sauvegarde?
Cordialement

[kiki29]

Salut, à titre documentaire : Obliger une saisie numérique dans une TextBox

[jean30]

Bonjour à chacun
Je vous met un lien vers le fichier (une quinzaine de lignes) car je ne maitrise pas du tout le Vba
Si vous pouvez résoudre aussi le problème exposé sur la feuille ce serait très sympa de votre part
En vous remerciant
https://www.cjoint.com/c/HDhh6mVcIxa

[patricktoulon]

bonjour
pour les textboxs avec formatage tu trouvera moulte exemples
le defit c'est plutot de gerer le tout dans un seul evenement
un exemple ici ,j'utilise l'evenement change ;interdis les caracteres non numerique ,interdit l'injection de numero mal formaté par macro

Code :

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

1
2
3
4
5
Private Sub TextBox1_Change()
    If Len(TextBox1.Text) = 14 And TextBox1 Like "*[A-z-a-z]*" Then TextBox1.Text = "err numero ": Exit Sub 'au cas ou le numero serait injecté par macro
    If TextBox1 Like "*[A-Z-a-z]*" Then TextBox1.Text = Left(TextBox1.Text, Len(TextBox1.Text) - 1) 'interdiction de caracteres autre que numerique
    TextBox1 = "0" & Format(Mid(TextBox1, 1, 14), Mid("## ## ## ## ## ", 1, Len(TextBox1))) 'formatage du numero
End Sub

ou bien encore

Code :

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

1
2
3
4
5
Private Sub TextBox1_Change()
    If ActiveControl.Name <> TextBox1.Name And TextBox1 Like "*[A-z-a-z]*" Then TextBox1.Text = "err numero ": Exit Sub  'au cas ou le numero serait injecté par macro
    If TextBox1 Like "*[A-Z-a-z]*" Then TextBox1.Text = Left(TextBox1.Text, Len(TextBox1.Text) - 1)    'interdiction de caracteres autre que numerique
    TextBox1 = "0" & Format(Mid(TextBox1, 1, 14), Mid("## ## ## ## ## ", 1, Len(TextBox1)))    'formatage du numero
End Sub

[jean30]

Bonjour kiki, patrick,
Je ne comprend pas e que je dois modifier

[Arkham46]

Bonjour,

Que donne la modification proposée par Transitoire quelques messages plus haut ?

[jean30]

Bonjour Arkham
Rien, ça affiche toujours les données dans les Textbox

[Arkham46]

Pourtant ça a l'air d'être à cet endroit.

Code :

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

For i = 1 To 21

traite les textbox de 1 à 21.
si vous ne souhaitez pas traiter certaines textbox, il suffit
- soit de faire plusieurs boucles comme proposé par Transitoire (attention la première boucle avait changé mais n'a pas été mise en vert) ;
- soit, pour éviter de multiplier le code identique, d'ajouter un test.

Code :

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

1
2
3
4
5
6
 
For i = 1 To 21
    If Not (i >= 3 And i <= 5 Or i >= 14 And i <= 17) Then
        Me.Controls("tb" & i) = c.Offset(0, i - 1)
    End If
Next

[Transitoire]

Exact , j'ai omis de mettre en vert la première boucle. je remet:

Set c = .Range("A:A").Find(ListBox1.Column(0)) 'on cherche l'emplacement dans la base
If Not c Is Nothing Then
For i = 1 To 2
Me.Controls("tb" & i) = c.Offset(0, i - 1)
Next i
For i = 6 To 13
Me.Controls("tb" & i) = c.Offset(0, i -1)
Next i
For i = 6 To 8 'pour les textbox de numéro de téléphone on met le format
Me.Controls("Tb" & i) = Format(Me.Controls("Tb" & i), "0# ## ## ## ##")
Next i
End If
End With

Je ne comprend pas non plus pourquoi ça ne marche pas, a moins qu'il ne faille en priorité effacer tous les textsBoxs parcequ'ils ont des valeurs dedans. En effet les valeurs ne sont pas entrés à l'initialisation, mais peut être à un moment ou il y a déja des valeurs, a ce moment la on les gardent telles quelle sont.

[jean30]

Arkham
Vous êtes bien gentils de chercher à m'aider mais je n'y comprend rien

[Transitoire]

Re bonjour,
Essayez le truc ci-dessous, j'ai rajouté à la partie verte, un partie code rose. ça remet les textboxs à zéro puis la partie verte permet de ne traiter que certains, les autres restant en l'état soit "" c'est à dire rien.

Set c = .Range("A:A").Find(ListBox1.Column(0)) 'on cherche l'emplacement dans la base
If Not c Is Nothing Then
For i = 1 To 21
Me.Controls("tb" & i) = ""
Next i
For i = 1 To 2
Me.Controls("tb" & i) = c.Offset(0, i - 1)
Next i
For i = 6 To 13
Me.Controls("tb" & i) = c.Offset(0, i -1)
Next i
For i = 6 To 8 'pour les textbox de numéro de téléphone on met le format
Me.Controls("Tb" & i) = Format(Me.Controls("Tb" & i), "0# ## ## ## ##")
Next i
End If
End With

[jean30]

Merci beaucoup c'est plus que parfait
C'est vraiment dur quand on ne comprend pas

[jean30]

Ca bloque ici
Me.Controls("Tb" & i) = Format(Me.Controls("Tb" & i), "0# ## ## ## ##")
surligné en jaune

J'ai trouvé, il me fallait modifier
Me.Controls("Tb" & i) = Format(Me.Controls("Tb" & i), "0### ### ###")

[Transitoire]

Tant mieux si c'est bon! On avait pas assez d'éléments. C'est sympa de penser a mettre un pouce levé lorsqu'une réponse vous aide
Cordialement

[jean30]

Je n'avais pas prêté attention au pouce, mais c'est fait
Merci beaucoup Transitoire
Il ne me reste plus qu'un problème mis dans autre post
Bon Week-end

[patricktoulon]

re
si les textboxs 3 a 5 existes il y avait un select case ou meme un switch dans une seule boucle

Code :

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

1
2
3
4
5
6
7
8
9
10
Set c = .Range("A:A").Find(ListBox1.Column(0))    'on cherche l'emplacement dans la base
    If Not c Is Nothing Then
        For i = 1 To 13
            Me.Controls("tb" & i) = c.Offset(0, i - 1)' on met la valeur de la cellule dans les 13 textboxs
            Select Case i
            Case 3 To 5: Me.Controls("tb" & i) = "" les textboxs 3 a 5 seront vides 
            Case 6 To 8: Me.Controls("Tb" & i) = Format(Me.Controls("Tb" & i), "0# ## ## ## ##") ' les 6 a 8 seront formatés 
            End Select
        Next i
    End If

[Transitoire]

Re
Excellent Patrick, je connaissait pas cette manière. par contre il manque je pense une ligne.

Set c = .Range("A:A").Find(ListBox1.Column(0)) 'on cherche l'emplacement dans la base
If Not c Is Nothing Then
For i = 1 To 13
Me.Controls("tb" & i) = c.Offset(0, i - 1)' on met la valeur de la cellule dans les 13 textboxs
Select Case i
Case 3 To 5: Me.Controls("tb" & i) = "" 'les textboxs 3 a 5 seront vides
Case 14 To 17: Me.Controls("tb" & i) = "" 'les textboxs 14 a 17 seront vides
Case 6 To 8: Me.Controls("Tb" & i) = Format(Me.Controls("Tb" & i), "0# ## ## ## ##") ' les 6 a 8 seront formatés
End Select
Next i
End If

Cordialement