[AC-2007] Détection des trous dans une séquence

Bonjour la Tunisie :P ,
Voici un code adapté à tes besoins, qui m'a beaucoup servi il y a quelques temps, il te crée une table avec les numéros disponibles :
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
Function fChercheSeries(pNomTable As String, pNomChamp As String)
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Recherche de plages de numéros disponibles  dans une table         "
'                                                                    "
' Paramètres : pNomTable : nom de la table contenant les données     "
'              pNomChamp : nom du champ de la table                  "
' Exemple : call fChercheSeries("Exemple", "champcle")               "
'                                                                    "
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
 
Dim lgDebInterv As Long
Dim lgFinInterv As Long
Dim lgInterval As Long
Dim I As Long
Dim boChpOK As Boolean
Dim oRst As Recordset
Dim oRstI As Recordset
Dim oRstO As Recordset
Dim stSQL As String
Dim stNomTable As String
 
On Error GoTo Gest_Erreur
' Contrôle existence table
    If IsNull(DLookup("[Name]", "Msysobjects", "[Type] = 1 and [Name]='" & pNomTable & "'")) Then
        MsgBox "Table " & pNomTable & " non trouvée dans la base.", , "RechercheSeries"
        Exit Function
    End If
 
' Contrôle existence du champ dans la table
    Set oRst = CurrentDb.OpenRecordset(pNomTable)
    For I = 0 To oRst.Fields.Count - 1
        If oRst.Fields(I).Name = pNomChamp Then
            boChpOK = True
            Exit For
        End If
    Next I
    oRst.Close
    Set oRst = Nothing
 
    If Not boChpOK Then
        MsgBox "Champ " & pNomChamp & " inexistant dans la table " & pNomTable & ".", , "RechercheSeries"
        Exit Function
    End If
' Contrôle existence données
    If DCount("*", pNomTable) = 0 Then
        MsgBox "La table " & pNomTable & " ne contient aucun enregistrement.", , "RechercheSeries"
        Exit Function
    End If
 
' Construction du nom de la table résultat
    stNomTable = "Series_" & pNomTable
    lgDebInterv = 1
    DoCmd.SetWarnings False
 
' Suppression de la table résultat si elle existe
    DoCmd.DeleteObject acTable, stNomTable
 
' Création de la table
    CurrentDb.Execute "CREATE TABLE " & stNomTable & "(" & pNomChamp & " Long)"
 
    Set oRstI = CurrentDb.OpenRecordset("SELECT " & pNomChamp & " FROM " & pNomTable & " ORDER BY 1;")
    Set oRstO = CurrentDb.OpenRecordset(stNomTable, dbOpenDynaset)
 
        While Not oRstI.EOF
 
            lgFinInterv = oRstI.Fields(pNomChamp)
            ' Calcul de la série entre 2 enregistrements
                        ' Si premier enregistrement
                If lgDebInterv = 1 And oRstI.AbsolutePosition = 0 Then
                    lgInterval = lgFinInterv - 1
                Else    ' Si autres enregistrements
                    lgInterval = (lgFinInterv - 1) - (lgDebInterv)
                End If
 
            ' Ecriture des intervalles
            If lgInterval > 0 Then
                For J = lgDebInterv + 1 To lgFinInterv - 1
                    oRstO.AddNew
                    oRstO.Fields(0) = J
                    oRstO.Update
                Next J
            End If
            lgDebInterv = lgFinInterv
 
           oRstI.MoveNext
 
        Wend
 
 
    DoCmd.SetWarnings True
    oRstI.Close
    oRstO.Close
    Set oRstI = Nothing
    Set oRstO = Nothing
 
    MsgBox "Recherche de séries terminée pour la table " & pNomTable, , "RechercheSeries"
 
Sortie_Fonction:
    Exit Function
 
Gest_Erreur:
 
        Select Case Err.Number
        Case 7874   ' table de travail non trouvée
        Resume Next
        Case Else
            MsgBox Err.Number & " Erreur - " & Err.Description, , "RechercheSeries"
            Resume Sortie_Fonction
        End Select
 
 
End Function