Discussion :

[wulfram]

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 :

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
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

[Jean-Philippe André]

bonjour,
sans voir les performances du code, la chose qui m'interpelle est que beaucoup de tes variables sont avec des accents. Et ca, c'est pas l'idéal. Imagine toi à devoir débugger le code depuis un clavier qwerty. :p

LA derniere partie avec la boucl for b me parait un peu obscure, mais pas de quoi casser la troisième patte de saturnin.

[wulfram]

bonjour,
sans voir les performances du code, la chose qui m'interpelle est que beaucoup de tes variables sont avec des accents. Et ca, c'est pas l'idéal. Imagine toi à devoir débugger le code depuis un clavier qwerty. :p

LA derniere partie avec la boucl for b me parait un peu obscure, mais pas de quoi casser la troisième patte de saturnin.

Hmm, okay pour les accents, je renommerai le tout une fois terminé.
Par contre, en fait, ça marche pas tant que ça : je ne peux pas ajouter de nouveaux enregistrements, la requête INSERT de la boucle for b (:p) ne fonctionne pas. Vive l'ajout du bouton "ajouter un document" de l'autre formulaire ! Encore une erreur de conversion de type...
Le champ numéroauto ne se crée qu'après fermeture du formulaire et/ou changement d'enregistrement ?
Est-il possible de faire un If newRec ? (un truc dans le genre quoi^^)