[Relecture de code]Formulaire modification de données multitable
Re-bonjour,
Pendant que j'attaque à nouveau le code du formulaire de recherche, (qui fonctionnait si bien avant une refonte de l'architecture de ma bdd) quelqu'un pourrait-il relire le code intégral de mon formulaire de modification des données et me dire s'il existe des méthodes, instructions, fonctions,... permettant d'améliorer les performances de l'ensemble ? Ou même des problèmes que je n'aurai pas vu ? (mais tout semble fonctionner^^)
En vous remerciant d'avance, voici le 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
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
| Option Compare Database
Option Explicit
Dim listespé As String
Dim startSpé As String
Dim startSociét As String
Dim startParu As Date
Private Sub btnAnnulExit_Click()
Me.txtSociété.Value = startSociét
Me.txtDate.Value = startParu
DoCmd.Close
End Sub
Private Sub btnAddSpé_Click()
Dim SpéAdd As String
listespé = lstSpécialités.RowSource
If Me.cboSpécialité.Value = "" Then
MsgBox ("Veuillez choisir une spécialité")
Exit Sub
End If
If InStr(listespé, Me.cboSpécialité.Value & ";") > 0 Then
MsgBox ("La spécialité que vous souhaitez ajouter est déjà dans la liste")
Exit Sub
Else
listespé = listespé & Me.cboSpécialité.Value & ";"
lstSpécialités.RowSource = listespé
lstSpécialités.Requery
End If
End Sub
Private Sub btnClassif_Click()
DoCmd.OpenForm "FrmClassification"
End Sub
Private Sub btnDelSpé_Click()
Dim SpéSelect As String
If IsNull(Me.lstSpécialités.Column(0)) = True Then
MsgBox ("Veuillez sélectionner une spécialité dans la liste ci-contre.")
Exit Sub
End If
SpéSelect = Me.lstSpécialités.Column(0)
listespé = Replace(listespé, SpéSelect & ";", "")
lstSpécialités.RowSource = listespé
lstSpécialités.Requery
End Sub
Private Sub btnsuppr_Click()
If MsgBox("Le document sera définitivement supprimé. Souhaitez-vous continuer ?", vbQuestion + vbYesNo, "INFORMATION") = vbYes Then
Me.AllowDeletions = True
DoCmd.SetWarnings False RunCommand acCmdSelectRecord
RunCommand acCmdDeleteRecord
DoCmd.SetWarnings True
Me.AllowDeletions = False
MsgBox "Le document a bien été supprimé"
DoCmd.Close
End If
End Sub
Private Sub Commande18_Click()
End Sub
Private Sub Form_Load()
cboCatégorie.RowSource = "SELECT [INDEXC].[Catégorie] FROM INDEXC ;"
cboSCatégorie.RowSource = ""
cboSpécialité.RowSource = ""
cboSCatégorie.Value = ""
cboSpécialité.Value = ""
txtDocRéf.BackColor = QBColor(7)
spéload
startSociét = Me.txtSociété
startParu = Me.txtDate
startSpé = Me.lstSpécialités.RowSource
Me.lststartspé.RowSource = startSpé
End Sub
Private Sub cboCatégorie_AfterUpdate()
cboSCatégorie.RowSource = "SELECT DISTINCT [INDEXSC].[SCatégorie]FROM INDEXSC " & _
"WHERE [INDEXSC].[Catégorie]='" & Me.cboCatégorie & "';"
cboSpécialité.RowSource = ""
cboSCatégorie.Value = ""
cboSpécialité.Value = ""
cboSCatégorie.Requery
cboSpécialité.Requery
End Sub
Private Sub cboScatégorie_AfterUpdate()
cboSpécialité.RowSource = "SELECT DISTINCT [INDEXS].[Spécialité] FROM INDEXS " & _
"WHERE [INDEXS].[SCatégorie]='" & Me.cboSCatégorie & "';"
cboSpécialité.Value = ""
cboSpécialité.Requery
End Sub
Public Sub spéload()
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("SELECT [SPEDOC].[Spécialité] FROM SPEDOC WHERE [SPEDOC].[DocRéf] = " & Me.txtDocRéf & "")
While Not rst.EOF
listespé = rst("Spécialité") & ";" & listespé
rst.MoveNext
Wend
lstSpécialités.RowSource = listespé
lstSpécialités.Requery
rst.Close
Set rst = Nothing
End Sub
Private Sub btnUpdaExit_Click()
If txtSociété.Value = "" Then
MsgBox ("Veuillez entrer un nom de société")
Exit Sub
End If
If txtDate.Value = "" Then
MsgBox ("veuillez entrer une date")
Exit Sub
End If
If Me.lstSpécialités.RowSource = "" Then
MsgBox ("Veuillez choisir au moins une spécialité")
Exit Sub
End If
If startSpé = listespé Then
DoCmd.Close
Exit Sub
End If
Dim avant As String
Dim après As String
Dim nbrchar As Integer
Dim Ref As Integer
Dim laspétest As String
Dim ajout As String
Dim supp As String
Dim b As Integer
Dim a As Integer
Ref = txtDocRéf.Value
ajout = ""
supp = ""
après = listespé
avant = startSpé
For a = 0 To (Me.lststartspé.ListCount - 1)
nbrchar = InStr(avant, ";")
laspétest = Left(avant, nbrchar - 1)
If InStr(après, laspétest) > 0 Then
après = Replace(après, laspétest & ";", "")
avant = Replace(avant, laspétest & ";", "")
Else
avant = Replace(avant, laspétest & ";", "")
supp = "DELETE * FROM SPEDOC WHERE [SPEDOC].[DocRéf] = " & Ref & " AND [SPEDOC].[Spécialité] = '" & laspétest & "'"
DoCmd.RunSQL supp
End If
Next a
For b = 0 To Me.lstSpécialités.ListCount
If après = "" Then
MsgBox ("Les modifications ont bien été apportées")
DoCmd.Close
Exit Sub
Else
nbrchar = InStr(après, ";")
laspétest = Left(après, nbrchar - 1)
après = Replace(après, laspétest & ";", "")
ajout = "INSERT INTO [SPEDOC] (DocRéf, Spécialité) VALUES ('" & Ref & "', '" & laspétest & "')"
DoCmd.RunSQL ajout
End If
Next b
End Sub |
