Discussion :

[Superpat9999]

Bonjour,
Je sais qu'on ne numérote plus les modules (marot_r me l'a dit). Mais moi, je le fais car je suis pas expert et j'aime bien trouver la ligne incriminée.
Je partage mon code, car j'ai galéré pour en trouver un (que je n'ai pas trouvé). Cela peux, peut-être servir encore
Les explications et les remerciements sont dans le module.
Je mets le code ci-dessous ainsi que dans un fichier zip.
S'il y a des problèmes n'hésitez pas à me le dire.

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
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
Rem Nom             NumForm
Rem Module          NumForm
Rem But             Numéroter et dénuméroter lignes du code des formulaires.
Rem Programmeur     Superpat9999
Rem Création        18/12/2020
Rem Version         Access 2016
Rem Version modif   1.1
'
'
Rem Modification
Rem Date 24/01/2021
Rem Ajouter numérotation à partir de 1000
'
' ** Numerotation Form_FormTest1 (n'oubliez pas de modifier le nom ou bien créer le Module et coller y les modules à numéroter.
'
' ---- Numerotation des Lignes
' On contrôle que sur le module il n'y a pas la ligne supplémentaire inscrite lors de la numérotation.
' Si elle n'est pas inscrite on ajoute la ligne "Numérotation existante par Superpat9999..." sur le module et on numérote
' Si elle est inscrite : fin de procédure, on ne numérote pas 2 fois.
 
' Vous devez paramétrer les lignes 14 et 16 du module  "Ajouter_Numerotation()" :
'     14 --> Le nom du formulaire dans Microsoft Access Objets de classe, voir, ci-dessus **
'     16 --> L'Incrementation, ici j'ai paramétré à 2, mais vous pouvez indiquer ce que vous voulez de 1 à 20, au dessus suivant le nombre de lignes,
'            il peut y avoir des problèmes, je n'ai pas essayé. A priori, vous pouvez numéroter jusqu'à 9999 lignes pour 1 formulaire.
'
' Pour lancer la macro, se positionner dans le module : Ajouter_Numerotation(), puis cliquer sur <F5>.
'
' ---- Suppression des Lignes
' Suppression des ligne d'une macro par Superpat9999, on contrôle que sur le module il y a la ligne supplémentaire inscrite lors de la numérotation.
' On supprime cette ligne : Numérotation existante par Superpat9999 sur la première ligne du programme, si elle existe.
' Si elle n'existe pas, avertissement, on ne peut pas la supprimer et fin du programme.
' Si elle n'existe, on retire l'intitulé et on numérote.
'
' Pour lancer la macro, se positionner dans le module : SupprimerNumerotation(), puis cliquer sur <F5>.
 
' Inspiration de mon listing :
' https://silkyroad.developpez.com/VBA/VisualBasicEditor/#LII-D
' https://www.developpez.net/forums/d336957/logiciels/microsoft-office/access/vba-access/numeroter-lignes-l-editeur-vba/
' Réponse de Random.
' https://www.developpez.net/forums/d2100603/logiciels/microsoft-office/access/macros-access/retrouver-code-ligne-erreur-apres-call/
' Réponse de marot_r.
 
Public strPositionEnregistrement As String
Public Const strSearch As String = "' * Numérotation existante par Superpat9999. Si vous effacez cette ligne, vous risquez de numéroter 2 fois :("
Dim strNomProcedure As String
Dim szMsg As String
Dim szStyle As String
Dim szTitle As String
Dim ErrLOg As String
Option Explicit
Option Compare Text
 
      Sub Ajouter_Numerotation()
      'Procédure qui vérifie si le formulaire est numéroté, s'il ne l'est pas, ajoute le titre et numérote.
          '
          Dim NomForm As String
          Dim bolExiste As Boolean
          Dim Reponse As Integer
          Dim Incrementation As Long
10        On Error GoTo errSub
12        strNomProcedure = "Ajouter_Numerotation"
          ' *********************************************************************************************
          ' * <--------- A changer suivant le nom du formulaire à incrémenter que vous voulez --------->
14        NomForm = "Form_FormTest1"
          ' * <--------- A changer suivant l'incrémentation que vous voulez --------->
16        Incrementation = 2
          ' * <---------Fin des modifs possibles et faciles --------->
          ' *********************************************************************************************
 
          ' Recherche si libellé existe
18        bolExiste = RechercheIntitule(NomForm, strSearch)
20        If bolExiste = True Then
              'Debug.Print "Existe, on sort"
22            szMsg = "Numérotation existante." & Chr(10) & Chr(10) & "Supprimer d'abord la numérotation du module " & _
              """" & NomForm & """." & Chr(10) & Chr(10) & "A bientôt !" ' Define message.
24            szStyle = vbInformation ' Define buttons.
26            szTitle = "Avertissement" ' Define title.
28            Reponse = MsgBox(szMsg, szStyle, szTitle)
              Exit Sub
30        Else
              'Debug.Print "Existe pas, on continue"
32            szMsg = "Il n'y a pas de numérotation !" & Chr(10) & Chr(10) & "Voulez-vous numéroter " & """" & NomForm & """ ?" ' Define message.
34            szStyle = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
36            szTitle = "Demande de confirmation" ' Define title.
38            Reponse = MsgBox(szMsg, szStyle, szTitle)
40            If Reponse = vbNo Then
                  Exit Sub
42            Else
                  ' On ajoute le titre
44                bolExiste = InsertIntitule(NomForm, strSearch)
                  ' on numérote
46                bolExiste = AjouteNum(NomForm, Incrementation)
48            End If
50        End If
52        MsgBox "Numérotation des Lignes, Procédure terminée.", vbInformation, "Fin du traitement"
 
Exitsub:
54        On Error GoTo 0
          Exit Sub
errSub:
          Select Case fGestError(strNomProcedure, Err, Erl, Err.Description)
              Case vbAbort
                  Exit Sub
              Case vbRetry
56                Resume
              Case vbIgnore
58                Resume Next
          End Select
      End Sub
      Function RechercheIntitule(strModuleName, strSearch) As Boolean
      'Procédure qui vérifie si le titre existe.
          Dim Mdl As Module
10        On Error GoTo errSub
          Set Mdl = Modules(strModuleName)
12        strNomProcedure = "RechercheIntitule"
          ' Return reference to Module object.
14        If Mdl.Find(strSearch, 1, 1, -1, -1, False, False, False) Then
              ' On trouve l'intitulé
16            RechercheIntitule = True
18        Else
20            RechercheIntitule = False
22        End If
Exitsub:
24        On Error GoTo 0
26        Exit Function
errSub:
          Select Case fGestError(strNomProcedure, Err, Erl, Err.Description)
              Case vbAbort
28                End
              Case vbRetry
30                Resume
              Case vbIgnore
32                Resume Next
          End Select
      End Function
      Function InsertIntitule(strModuleName, strSearch As String) As Boolean
      'Procédure qui ajoute le titre.
          Dim Mdl As Module
10        On Error GoTo errSub
12        strNomProcedure = "InsertIntitule"
          Set Mdl = Modules(strModuleName)
          ' Insert texte au début du module, à la ligne 1.
14        Mdl.InsertLines 1, strSearch
16        InsertIntitule = True
Exitsub:
18        On Error GoTo 0
20        Exit Function
errSub:
          Select Case fGestError(strNomProcedure, Err, Erl, Err.Description)
              Case vbAbort
22                End
              Case vbRetry
24                Resume
              Case vbIgnore
26                Resume Next
          End Select
      End Function
      Function AjouteNum(NomMacro As String, Incrementation As Long)
      'Procédure qui numérote.
          Dim Mdl As Module
          Dim Boucle As Long
          Dim maLigne As String
          Dim Debut As Integer, Fin As Integer, i As Integer
          Dim Ligne As Integer, x As Integer
          Dim strVar As String, strVar2 As String, Underscore As Integer
          Dim TitreUnder As Integer
          Dim Espace As String, EspaceNonNum As String
          Dim Espace100 As String
          Dim Espace1000 As String
          Set Mdl = Modules(NomMacro)
10        On Error GoTo errSub
12        strNomProcedure = "AjouteNum"
14        Ligne = 10
16        Espace = "    " ' 4
18        EspaceNonNum = "      " ' 6
20        Espace100 = "   " ' 3
22        Espace1000 = "  " ' 2
24        Underscore = 0
26        For Boucle = Mdl.CountOfDeclarationLines + 1 To Mdl.CountOfLines
28            maLigne = (Mdl.Lines(Boucle, 1))
30            strVar = maLigne
32            strVar2 = Replace(Trim(maLigne), " ", "")
34            If Ligne < 100 Then
36                If Left(strVar2, 3) = "Sub" Or _
                  Left(strVar2, 6) = "EndSub" Or _
                  Left(strVar2, 7) = "ExitSub" Or _
                  Left(strVar2, 6) = "Public" Or _
                  Left(strVar2, 10) = "PrivateSub" Or _
                  Left(strVar2, 9) = "PublicSub" Or _
                  Left(strVar2, 8) = "Function" Or _
                  Left(strVar2, 11) = "EndFunction" Or _
                  Left(strVar2, 10) = "PrivateSub" Or _
                  Left(strVar2, 7) = "Private" Or _
                  Left(strVar2, 14) = "PublicFunction" Or _
                  Left(strVar2, 3) = "Rem" Or _
                  Left(strVar2, 1) = "'" Or _
                  Len(Left(strVar2, 1)) = 0 Or _
                  Left(strVar2, 10) = "SelectCase" Or _
                  Left(strVar2, 4) = "Case" Or _
                  Left(strVar2, 10) = "EndSelect" Or _
                  Left(strVar2, 3) = "Dim" Or _
                  Left(strVar2, 3) = "Set" Or _
                  Left(strVar2, 5) = "Const" Or _
                  Right(strVar2, 1) = ":" Then
38                    strVar = EspaceNonNum & strVar
40                If Left(strVar2, 8) = "Function" And Right(strVar2, 1) = "_" Or _
                     Left(strVar2, 7) = "Private" And Right(strVar2, 1) = "_" Then
                       ' Une fonction contient underscore
42                     Debug.Print strVar2 & "ligne B: " & Ligne
44                     Underscore = "1"
46                End If
48                ElseIf Right(strVar2, 1) = "_" Or Underscore = 1 Then
50                    If Underscore = 0 Then
                          'Premier _, on numérote
52                        strVar = Ligne & Espace & strVar
54                        Ligne = Ligne + Incrementation
56                        Underscore = "1"
58                    ElseIf Underscore = 1 And Right(strVar2, 1) = "_" Then
                          'Deuxième ligne, celle d'avant a été numérotée et on a encore "_"
                          'On ne numérote pas
60                        Underscore = "1"
62                        strVar = EspaceNonNum & strVar
64                    ElseIf Underscore = 1 Then
                          'Troisième ligne, celle d'avant a été numérotée et on a pas "_"
                          'On ne numérote pas
66                        Underscore = "0"
68                        strVar = EspaceNonNum & strVar
70                    End If
72                Else
                      ' Tous les autres sont numérotés
74                        strVar = Ligne & Espace & strVar
76                        Ligne = Ligne + Incrementation
78                End If
80            ElseIf Ligne > 99 And Ligne < 1000 Then
82                If Left(strVar2, 3) = "Sub" Or _
                  Left(strVar2, 6) = "EndSub" Or _
                  Left(strVar2, 7) = "ExitSub" Or _
                  Left(strVar2, 6) = "Public" Or _
                  Left(strVar2, 10) = "PrivateSub" Or _
                  Left(strVar2, 9) = "PublicSub" Or _
                  Left(strVar2, 8) = "Function" Or _
                  Left(strVar2, 11) = "EndFunction" Or _
                  Left(strVar2, 10) = "PrivateSub" Or _
                  Left(strVar2, 7) = "Private" Or _
                  Left(strVar2, 14) = "PublicFunction" Or _
                  Left(strVar2, 3) = "Rem" Or _
                  Left(strVar2, 1) = "'" Or _
                  Len(Left(strVar2, 1)) = 0 Or _
                  Left(strVar2, 10) = "SelectCase" Or _
                  Left(strVar2, 4) = "Case" Or _
                  Left(strVar2, 10) = "EndSelect" Or _
                  Left(strVar2, 3) = "Dim" Or _
                  Left(strVar2, 3) = "Set" Or _
                  Left(strVar2, 5) = "Const" Or _
                  Right(strVar2, 1) = ":" Then
84                    strVar = EspaceNonNum & strVar
86                If Left(strVar2, 8) = "Function" And Right(strVar2, 1) = "_" Or _
                     Left(strVar2, 7) = "Private" And Right(strVar2, 1) = "_" Then
                       ' Une fonction contient underscore
88                     Underscore = "1"
90                End If
92                ElseIf Right(strVar2, 1) = "_" Or Underscore = 1 Then
94                    If Underscore = 0 Then
                          'Premier _, on numérote
96                        strVar = Ligne & Espace100 & strVar
98                        Ligne = Ligne + Incrementation
100                       Underscore = "1"
102                   ElseIf Underscore = 1 And Right(strVar2, 1) = "_" Then
                          'Deuxième ligne, celle d'avant a été numérotée et on a encore "_"
                          'On ne numérote pas
104                       Underscore = "1"
106                       strVar = EspaceNonNum & strVar
108                   ElseIf Underscore = 1 Then
                          'Troisième ligne, celle d'avant a été numérotée et on a pas "_"
                          'On ne numérote pas
110                       Underscore = "0"
112                       strVar = EspaceNonNum & strVar
114                   End If
116               Else
                      ' Tous les autres sont numérotés
118                   strVar = Ligne & Espace100 & strVar
120                   Ligne = Ligne + Incrementation
122               End If
124           ElseIf Ligne > 999 Then
126               If Left(strVar2, 3) = "Sub" Or _
                  Left(strVar2, 6) = "EndSub" Or _
                  Left(strVar2, 7) = "ExitSub" Or _
                  Left(strVar2, 6) = "Public" Or _
                  Left(strVar2, 10) = "PrivateSub" Or _
                  Left(strVar2, 9) = "PublicSub" Or _
                  Left(strVar2, 8) = "Function" Or _
                  Left(strVar2, 11) = "EndFunction" Or _
                  Left(strVar2, 10) = "PrivateSub" Or _
                  Left(strVar2, 7) = "Private" Or _
                  Left(strVar2, 14) = "PublicFunction" Or _
                  Left(strVar2, 3) = "Rem" Or _
                  Left(strVar2, 1) = "'" Or _
                  Len(Left(strVar2, 1)) = 0 Or _
                  Left(strVar2, 10) = "SelectCase" Or _
                  Left(strVar2, 4) = "Case" Or _
                  Left(strVar2, 10) = "EndSelect" Or _
                  Left(strVar2, 3) = "Dim" Or _
                  Left(strVar2, 3) = "Set" Or _
                  Left(strVar2, 5) = "Const" Or _
                  Right(strVar2, 1) = ":" Then
128                   strVar = EspaceNonNum & strVar
130               If Left(strVar2, 8) = "Function" And Right(strVar2, 1) = "_" Or _
                     Left(strVar2, 7) = "Private" And Right(strVar2, 1) = "_" Then
                       ' Une fonction contient underscore
132                    Underscore = "1"
134               End If
136               ElseIf Right(strVar2, 1) = "_" Or Underscore = 1 Then
138                   If Underscore = 0 Then
                          'Premier _, on numérote
140                       strVar = Ligne & Espace1000 & strVar
142                       Ligne = Ligne + Incrementation
144                       Underscore = "1"
146                   ElseIf Underscore = 1 And Right(strVar2, 1) = "_" Then
                          'Deuxième ligne, celle d'avant a été numérotée et on a encore "_"
                          'On ne numérote pas
148                       Underscore = "1"
150                       strVar = EspaceNonNum & strVar
152                   ElseIf Underscore = 1 Then
                          'Troisième ligne, celle d'avant a été numérotée et on a pas "_"
                          'On ne numérote pas
154                       Underscore = "0"
156                       strVar = EspaceNonNum & strVar
158                   End If
160               Else
                      ' Tous les autres sont numérotés
162                   strVar = Ligne & Espace1000 & strVar
164                   Ligne = Ligne + Incrementation
166               End If
168           End If
170           Mdl.ReplaceLine Line:=Boucle, String:=strVar
172           If Left(strVar2, 11) = "EndFunction" Or Left(strVar2, 6) = "EndSub" Then
174               Ligne = 10
176           End If
178       Next Boucle
Exitsub:
180       On Error GoTo 0
182       Exit Function
errSub:
          Select Case fGestError(strNomProcedure, Err, Erl, Err.Description)
              Case vbAbort
184               Exit Function
              Case vbRetry
186               Resume
              Case vbIgnore
188               Resume Next
          End Select
      End Function
      '----------------------------------------------------------------------------------------------------------------
      '----------------------------------------------------------------------------------------------------------------
      '----------------------------------------------------------------------------------------------------------------
      Sub SupprimerNumerotation()
      'Procédure qui vérifie si le formulaire est numéroté, si oui, supprime le titre ensuite supprime la numérotation.
          Dim NomForm As String
          Dim bolExiste As Boolean
          Dim bolEfface As Boolean
          Dim Reponse As Integer
10        On Error GoTo errSub
12        strNomProcedure = "SupprimerNumerotation"
14        NomForm = "Form_FormTest1"
          ' Recherche si libellé existe
16        bolExiste = RechercheIntitule(NomForm, strSearch)
18        If bolExiste = True Then
              'Debug.Print "Existe, on supprime l'intitulé, après question"
              ' Le fichier est déjà numéroter
20            szMsg = "Numérotation existante." & Chr(10) & Chr(10) & "Voulez-vous supprimer la numérotation de " & NomForm & " ?" ' Define message.
22            szStyle = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
24            szTitle = "Demande de confirmation" ' Define title.
26            Reponse = MsgBox(szMsg, szStyle, szTitle)
28            If Reponse = vbNo Then
30                MsgBox "A bientôt !", vbInformation, "Fin du traitement"
                  Exit Sub
32            Else
                  ' On supprime le titre
34                bolEfface = DeleteWholeLine(NomForm, strSearch)
36                If bolEfface = True Then
38                    Debug.Print "deleted successfully."
40                Else
42                    Debug.Print "not deleted."
44                End If
                  ' on enlève la numérotation
46                SupprimeNumLignes (NomForm)
48            End If
50        Else
52            Reponse = vbNo
54            szMsg = "Il n'y a pas de numérotation !"
56            MsgBox szMsg & Chr(10) & "A bientôt !", vbInformation, "Fin du traitement"
              Exit Sub
58        End If
60        MsgBox "La suppression de la numérotation des Lignes terminée.", vbInformation, "Fin du traitement"
Exitsub:
62        On Error GoTo 0
          Exit Sub
errSub:
          Select Case fGestError(strNomProcedure, Err, Erl, Err.Description)
              Case vbAbort
                  Exit Sub
              Case vbRetry
64                Resume
              Case vbIgnore
66                Resume Next
          End Select
      End Sub
      Function DeleteWholeLine(strModuleName, strText As String) _
      As Boolean
      'Procédure qui recherche et supprime l'intitulé.
          Dim Mdl As Module, lngNumLines As Long
          Dim lngSLine As Long, lngSCol As Long
          Dim lngELine As Long, lngECol As Long
          Dim strTemp As String
10        On Error GoTo errSub
12        strNomProcedure = "DeleteWholeLine"
          Set Mdl = Modules(strModuleName)
14        If Mdl.Find(strText, lngSLine, lngSCol, lngELine, lngECol) Then
16            lngNumLines = Abs(lngELine - lngSLine) + 1
18            strTemp = LTrim$(Mdl.Lines(lngSLine, lngNumLines))
20            strTemp = RTrim$(strTemp)
22            If strTemp = strText Then
24                Mdl.DeleteLines lngSLine, lngNumLines
26                DeleteWholeLine = True
                  'Debug.Print "Ligne trouvé dans '" & strModuleName & "'."
28           Else
                  'Debug.Print "Ligne non trouvé dans '" & strModuleName & "'."
30                DeleteWholeLine = False
32            End If
34        Else
              'Debug.Print "Text '" & strTemp & "' not found."
36            DeleteWholeLine = False
38        End If
Exitsub:
40        On Error GoTo 0
42        Exit Function
errSub:
          Select Case fGestError(strNomProcedure, Err, Erl, Err.Description)
              Case vbAbort
44                End
              Case vbRetry
46                Resume
              Case vbIgnore
48                Resume Next
          End Select
      End Function
      Function SupprimeNumLignes(NomForm)
      'Procédure qui supprime la numérotation.
          Dim Mdl As Module
          Dim Boucle As Long
          Dim maLigne As String
          Dim strVar As String
          Set Mdl = Modules(NomForm)
10        On Error GoTo errSub
12        strNomProcedure = "SupprimeNumLignes"
14        For Boucle = Mdl.CountOfDeclarationLines + 1 To Mdl.CountOfLines
16            maLigne = (Mdl.Lines(Boucle, 1))
18            strVar = maLigne
20            If Right(strVar, 1) <> ":" Then
22                 strVar = Mid(strVar, 7)
24                 Mdl.ReplaceLine Line:=Boucle, String:=strVar
26             Else
28                 Debug.Print strVar
30             End If
32        Next Boucle
Exitsub:
34        On Error GoTo 0
36        Exit Function
errSub:
          Select Case fGestError(strNomProcedure, Err, Erl, Err.Description)
              Case vbAbort
38                End
              Case vbRetry
40                Resume
              Case vbIgnore
42                Resume Next
          End Select
      End Function
 
      Public Function fGestError(vModule As String, vErr As Long, vErrLigne As Long, vErrDescription As String, Optional booDisplayMsg = True) As VbMsgBoxResult
10        fGestError = MsgBox("Une erreur c'est produite dans : " & vbCrLf & vbCrLf & _
          "Procédure : " & vModule & vbCrLf & _
          "Ligne N° : " & vErrLigne & vbCrLf & _
          "Erreur N° " & vErr & vbCrLf & _
          "Description : " & vErrDescription & vbCrLf & vbCrLf & _
          "Date : " & Date & " et " & "Heure : " & Time & vbCrLf & vbCrLf & _
          "Ctrl+shift+F : Debug On/Off -- Mode Debug = " & IIf(False, "Actif", "Passif") _
          , vbAbortRetryIgnore + vbCritical, strversion)
      End Function

[marot_r]

Bonjour (et merci pour la citation :-) ).

As-tu regardé MzTools (https://access.developpez.com/outils/?page=vbe#MzTools) il me semble qu'il y une option pour numéroter les lignes.

Je ne t'en avais pas parlé avant car tu semblais avoir trouvé un méthode viable.

A+

[marot_r]

Et une autre méthode consisterai peut-être à

1. exporter les modules en fichier texte,
2. numéroter séquentiellement les lignes dans le fichier
3. puis réimporter ce module numéroté.

Sans doute moins élégant que ta solution mais peut être faisable.

A+

[Superpat9999]

Bonjour (et merci pour la citation :-) ).
As-tu regardé MzTools (https://access.developpez.com/outils/?page=vbe#MzTools) il me semble qu'il y une option pour numéroter les lignes.
Je ne t'en avais pas parlé avant car tu semblais avoir trouvé un méthode viable.
A+

Merci marot_r,
Mais solution trop onéreuse pour mon petit travail :
C'était gratuit (dans le temps), maintenant payant.
La version 3 ne fonctionne pas chez moi, j'avais essayé de l'installer.
J'ai gagné une soixantaine d'euros.

[Dermochelys]

Bonjour Superpat9999,

J'ai essayé d'utiliser ton module de numérotation, histoire de voir comment il fonctionne, mais en le lançant je récupère une erreur sur la ligne 10 : il ne trouve pas le Form_Test que j'ai spécifié sur la ligne 14.
Or ce module du Formulaire Test existe bel et bien.
Serait-ce un problème de version (suis sous Access 2010)?

Cordialement

[Superpat9999]

Effectivement, il semble y avoir un problème, je regarde ce soir.

[Dermochelys]

Merci Superpat9999
J'espère que tu n'y passeras pas une nuit blanche

[Superpat9999]

Merci Superpat9999
J'espère que tu n'y passeras pas une nuit blanche

Merci, après essai, tout c'est bien passé. Il n'y a pas d'erreur.

J'ai fait un copier coller d'un de mes formulaires, je l'ai renommé FormTest1 et lancé la procédure : Ajouter_Numerotation.
C'était Ok.
Essaie à nouveau en vérifiant le nom de ton formulaire, si tu ne gardes pas le nom de FormTest1 pour ton formulaire, modifie le code, mais garde bien Form_ devant le nom

Code :

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

NomForm = "Form_FormTest1"

Modifié :

Code :

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

NomForm = "Form_NouveauNom"

N’hésite pas à me dire la suite de ton essai

[Dermochelys]

Bonjour Superpat9999,

Merci pour ta réponse détaillée.

L'import du fichier bas est ok. Suite au renommage du module à numéroter, il n'y a plus d'erreur à ce niveau.
Mais il me met une erreur sur la function "Function 'fGestError' : Erreur de compilation, variable non définie "
La variable en question semble être 'strversion'. Si je déclare la variable en variant dans cette fonction, ca se lance mais je récupère d'autres erreurs
La première

puis en cliquant sur ignorer

et enfin


Sauf que mon module ne contient aucune numérotation du tout...

Etrange... je creuse de mon côté pour savoir pourquoi...

PS: je suis sous Access 2010

[Superpat9999]

Bonjour Dermochelys,
Pour le strVersion, tu modifies le code en supprimant strVersion, c'est une erreur de ma part, je n'ai pas mis la version en public dans ce module mais dans un autre module :

Code :

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

1
2
3
4
5
6
7
8
9
10
      Public Function fGestError(vModule As String, vErr As Long, vErrLigne As Long, vErrDescription As String, Optional booDisplayMsg = True) As VbMsgBoxResult
10        fGestError = MsgBox("Une erreur c'est produite dans : " & vbCrLf & vbCrLf & _
          "Procédure : " & vModule & vbCrLf & _
          "Ligne N° : " & vErrLigne & vbCrLf & _
          "Erreur N° " & vErr & vbCrLf & _
          "Description : " & vErrDescription & vbCrLf & vbCrLf & _
          "Date : " & Date & " et " & "Heure : " & Time & vbCrLf & vbCrLf & _
          "Ctrl+shift+F : Debug On/Off -- Mode Debug = " & IIf(False, "Actif", "Passif") _
          , vbAbortRetryIgnore + vbCritical)
      End Function

Comme tu as lancé ton formulaire et qu'il y a eu interruption de la macro, j'ai eu le temps d'écrire dans ton formulaire :

Efface la première ligne dans "Form_FormTest1" et relance la procédure.
Si cela fonctionne, je modifierai le marquage dans le fichier pour qu'il ne se fasse qu'après réussite de la numérotation.
Tiens-moi au courant.

[Dermochelys]

Re-bonjour Superpat9999,

OK j'ai viré la variable concernant la version.

Par contre, je ne trouve dans aucun de mes modules (sauf dans le module NumForm) la phrase que tu me suggères d'enlever ... A croire qu'elle n'est pas recopiée dans le module à numéroter...
Il n'y a pas quelque chose à éditer dans les préférences pour que NumForm puisse écrire dans d'autres modules?

[Superpat9999]

Enlève là dans NumForm, car elle empêche la numérotation

[Superpat9999]

NumForm a-t-il été numéroté ?

[Dermochelys]

Non, NumForm n'a pas été renuméroté une seconde fois (après importation du fichier *.bas, ce module est déjà numéroté)


Je viens de faire un autre test.
Dans le module Form_FormTest1, j'ai copié le contenu de NumForm (vu qu'il est numéroté). Puis j'ai lancé la suppression des numéros.
Là, j'ai un message d'erreur qui me dit que la Public Const strSearch As String = "' * Numér...." n'est pas autorisée. Du coup, j'ai enlevé la ligne déclarant cette constante dans le Form_FormTest1. Puis j'ai lancé la suppression de la numérotation. Et tout fonctionne bien.
Idem quand je lance la numérotation.

Par contre, quand je remplace le contenu de Form_FormTest1 par le contenu d'un de mes modules, ça bug à nouveau (même message d'erreur que précédemment). Pas de numérotation, ni de contenu de la variable strSearch inscrit dans le code.

Donc ton code fonctionne, mais il y a un bug qq part avec mes modules, mais je n'y vois rien de bizarre... Je te mets ici en exemple le code d'un de mes modules. Tu en dis quoi?

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
Option Compare Database
Option Explicit
 
Private Sub Commande56_Click()
    DoCmd.OpenForm "Infos"
End Sub
 
Private Sub Commentaires_DblClick(Cancel As Integer)
    DoCmd.OpenForm "Formulaire1", , , "N° = " & (Me.[N°]), acFormEdit, acWindowNormal, "EditOneOnly"
End Sub
 
Private Sub Espèce_DblClick(Cancel As Integer)
    DoCmd.OpenForm "Formulaire1", , , "N° = " & (Me.[N°]), acFormEdit, acWindowNormal, "EditOneOnly"
End Sub
 
Private Sub Famille_DblClick(Cancel As Integer)
    DoCmd.OpenForm "Formulaire1", , , "N° = " & (Me.[N°]), acFormEdit, acWindowNormal, "EditOneOnly"
End Sub
 
Private Sub Form_Current()
'Me.Checked = Me.N°
Me.Étiquette46.Caption = "Select?"
 
Me.N°.Locked = True
Me.Ordre.Locked = True
Me.Famille.Locked = True
Me.SousFamille.Locked = True
Me.Genre.Locked = True
Me.Espèce.Locked = True
Me.NomcommunFR.Locked = True
Me.NomcommunNL.Locked = True
Me.Race.Locked = True
Me.Commentaires.Locked = True
Me.Origine.Locked = True
Me.Ref.Locked = True
 
End Sub
 
Private Sub Genre_DblClick(Cancel As Integer)
    DoCmd.OpenForm "Formulaire1", , , "N° = " & (Me.[N°]), acFormEdit, acWindowNormal, "EditOneOnly"
End Sub
 
Private Sub N°_DblClick(Cancel As Integer)
    DoCmd.OpenForm "Formulaire1", , , "N° = " & (Me.[N°]), acFormEdit, acWindowNormal, "EditOneOnly"
End Sub
 
Private Sub NomcommunFR_DblClick(Cancel As Integer)
    DoCmd.OpenForm "Formulaire1", , , "N° = " & (Me.[N°]), acFormEdit, acWindowNormal, "EditOneOnly"
End Sub
 
Private Sub NomcommunNL_DblClick(Cancel As Integer)
    DoCmd.OpenForm "Formulaire1", , , "N° = " & (Me.[N°]), acFormEdit, acWindowNormal, "EditOneOnly"
End Sub
 
Private Sub Ordre_DblClick(Cancel As Integer)
    DoCmd.OpenForm "Formulaire1", , , "N° = " & (Me.[N°]), acFormEdit, acWindowNormal, "EditOneOnly"
End Sub
 
Private Sub Origine_DblClick(Cancel As Integer)
    DoCmd.OpenForm "Formulaire1", , , "N° = " & (Me.[N°]), acFormEdit, acWindowNormal, "EditOneOnly"
End Sub
 
Private Sub Race_DblClick(Cancel As Integer)
    DoCmd.OpenForm "Formulaire1", , , "N° = " & (Me.[N°]), acFormEdit, acWindowNormal, "EditOneOnly"
End Sub
 
Private Sub Ref_DblClick(Cancel As Integer)
    DoCmd.OpenForm "Formulaire1", , , "N° = " & (Me.[N°]), acFormEdit, acWindowNormal, "EditOneOnly"
End Sub
 
Private Sub SousFamille_DblClick(Cancel As Integer)
    DoCmd.OpenForm "Formulaire1", , , "N° = " & (Me.[N°]), acFormEdit, acWindowNormal, "EditOneOnly"
End Sub
 
Private Sub ToPrint_Click()
On Error GoTo ToPrint_Click
 
    Dim oDb As DAO.Database
    Dim oRst As DAO.Recordset
    Dim StrSQL As String
    Dim a As Long
 
    'SQL sur les tables liées et la table principale
    StrSQL = "SELECT * FROM [Espece] WHERE [ToPrint]= True"
 
    'Instancie la base de données
    Set oDb = CurrentDb()
    'Ouvre le curseur
    Set oRst = oDb.OpenRecordset(StrSQL)
 
    If Not oRst.EOF Then
        oRst.MoveLast
        oRst.MoveFirst
    End If
 
    If Me.ToPrint.Value = True Then
        a = oRst.RecordCount
        Me.Parent.Caption = "Base de données des collections de références" & " - " & a + 1 & " enregistrement(s) sélectionné(s)"
        Me.Parent.Requery
    End If
    If Me.ToPrint.Value = False Then
        a = oRst.RecordCount
        Me.Parent.Caption = "Base de données des collections de références" & " - " & IIf(a > 1, a - 1, 0) & " enregistrement(s) sélectionné(s)"
        Me.Parent.Requery
    End If
 
 
    'Libération des objets
    If Not oRst Is Nothing Then oRst.Close: Set oRst = Nothing
    If Not oDb Is Nothing Then oDb.Close: Set oDb = Nothing
 
Exit_ToPrint_Click:
    Exit Sub
 
ToPrint_Click:
    MsgBox "Erreur '" & err.Description & "' !", vbOKOnly + vbInformation
    Resume Exit_ToPrint_Click
 
End Sub

[Superpat9999]

Excuse-moi Dermochelys, je n'avais pas vu ta réponse. Où en es-tu ?
Je suis à nouveau sur mon module d'ici 2 ou 3 jours, je pense le simplifier et l'améliorer.
N'hésite pas à me recontacter.

[Superpat9999]

Bien, j'ai repris mon code afin de simplifier. Il n'y a que 1 mot et 1 nombre à modifier dans le code, le nom du fichier et l'incrémentation :
1-

Code :

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

1
2
3
4
5
  ' *********************************************************************************************
  ' * <--------- Changer le nom FormTest1, ci-dessous en nom du formulaire que vous voulez incrémenter. Laisser les quotes ""  --------->
Public Const Nomformulaire As String = "FormTest1"
 ' * <--------- Fin de la modif nom du formulaire --------->
 ' **********************************************************************************************

Remplacer FormTest1 par le nom de votre formulaire à numéroter.

2- la ligne 16 du module "Ajouter_Numerotation()"
L'Incrementation, que j'ai paramétré à 2, mais vous pouvez indiquer le nombre que vous voulez. Ou encore le laisser à 2.

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
' *
      Sub Ajouter_Numerotation()
      'Procédure qui vérifie si le formulaire est numéroté, s'il ne l'est pas, ajoute le titre et numérote.
          '
          Dim NomForm As String
          Dim bolExiste As Boolean
          Dim Reponse As Integer
          Dim Incrementation As Long
10        On Error GoTo errSub
12        strNomProcedure = "Ajouter_Numerotation"
14        NomForm = "Form_" & Nomformulaire
          ' * <--------- A changer suivant l'incrémentation que vous voulez --------->
16        Incrementation = 2
          ' * <---------Fin de la modif incrémentation --------->
          ' *********************************************************************************************

Je mets le nouveau code dans un fichier zip ci-dessous.
S'il y a des problèmes n'hésitez pas à me le dire.