25/01/2012, 12h05
|
#1
|
|
Membre éclairé
  Pierre Amateur Inscription : octobre 2010 Messages : 205 Détails du profil  Informations personnelles : Nom : Pierre Âge : 35 Localisation : France, Yvelines (Île de France)
Informations professionnelles :
Activité : Amateur
Informations forums :
Inscription : octobre 2010 Messages : 205 Points : 353 Points : 353
|
Ajouter en VBA une astérisque aux champs obligatoires dans un formulaire
Bonjour,
J'en avais marre de mettre manuellement des astérisques à côté des champs obligatoires dans un formulaire, j'ai donc écrit cette fonction. Cependant, elle génère une erreur à la ligne 50 sur "ctrlX.Parent", erreur de type à priori. Quelqu'un à une idée ?
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
|
Public Sub AjouteAsterisque(ByVal FormulaireCible As String)
Dim recX As Recordset, formX As Form, ctrlX As Control, fieldX As Field, NewLabel As Control
Dim blSuppr As Boolean
DoCmd.OpenForm FormulaireCible, acDesign 'Ouverture du formulaire en mode création
Set formX = Application.Forms(FormulaireCible) 'Affectation du formulaire à la variable formX
'Vérifions d'abord si le formulaire est lié à une source de données !
If formX.RecordSource <> "" Then
Set recX = CurrentDb.OpenRecordset(formX.RecordSource)
Else
Exit Sub 'Le formulaire n'est pas lié, fin de la procédure
End If
'Suppression des précedentes étiquettes
'On va balayer les contôles (For... Next) et si le nom correspond à une étiquette astérisque alors on le supprime
'Cependant quand on supprime un contrôle, la collection est modifiée !
'On va donc boucler avec Do until et refaire le balayage jusqu'à ce qu'il n'y ait plus d'étiquette astérisque
blSuppr = True
Do Until blSuppr = False
For Each ctrlX In formX.Controls
blSuppr = False 'Met l'indicateur à faux
If Left$(ctrlX.Name, 4) = "ast_" Then 'si le nom du contôle comme par...
DeleteControl FormulaireCible, ctrlX.Name 'Suppression du contrôle
blSuppr = True 'Met l'indicateur à Vrai
End If
Next ctrlX
Loop
'Création des étiquettes.
'On balaye tous les contôles For...Next
'On ne prend en compte que les contrôles Textbox et combobox
'On récupère le champ lié, puis on vérifie si le champ doit être renseigné (propriéts Required et AllowZeroLength
For Each ctrlX In formX.Controls 'balaye tous les contôles du formulaire
'Debug.Print TypeName(ctrlX)
If TypeName(ctrlX) = "Textbox" Or TypeName(ctrlX) = "Combobox" Then
If ctrlX.ControlSource <> "" Then 'le contrôle est lieu à un champ
Set fieldX = recX.Fields(ctrlX.ControlSource) 'Affectation du champ à la variable fieldX
If Not fieldX.AllowZeroLength Or fieldX.Required Then 'Le champ doit être différent de Null ou la chaine ne peut être vide
'Création de l'étiquette, les coordonnées sont en fonction du contrôle "source"
'La propriété ctrlX.Parent permet de récupérer le conteneur (par exemple un onglet)
Set NewLabel = CreateControl(FormulaireCible, acLabel, , ctrlX.Parent, , _
ctrlX.Left + ctrlX.Width + 60, ctrlX.Top - 45, 250, 250)
NewLabel.Name = "ast_" & ctrlX.Name 'le nom de l'éatiquette reprend le nom du contôle
NewLabel.Caption = "*" 'Met une astérisque (ou ce qu'on veut !)
NewLabel.FontName = "MS Sans Serif" 'Police MS Sans Serif (ou ce qu'on veut)
NewLabel.FontSize = 14 'Taille de police
NewLabel.ForeColor = vbRed 'En rouge
End If
End If
End If
Next ctrlX
Exit Sub
Err_Gest:
Resume Next
End Sub |
|
|
00
|
