[Débutant] Parcours base access

Parcours base access

Bonjour,

Je fais des traitements à partir de bases de données access 95 (des dossiers de comptabilité de sociétés).
Le parcours de certaines bases de données est perturbé : souvent l'instruction movenext est exécuté à la deuxième boucle (je traite deux fois le même enregistrement avant de passer au suivant).

Ca ne se produit pas avec toutes les bases de données.
La conversion de la base de donnée au format access 2003 ne résoud rien.
Le compactage de la base de données non plus.

J'ai ouvert la base de données avec un "order by".
Je peux essayer de ne pas utiliser d'index mais ça va devenir lent ...

Je sèche ...

Quelqu'un a-t-il rencontré ce problème et trouvé une solution ?

Merci.

Peut-on voir le code ? ;)

Bonjour,

Bien sûr.

En résumé ... je lis des dossiers comptable (1ère boucle "MonInt") puis leur fichier "Ecritures" (rs.ecr) et je fais une balance comptable recalculée par journal (les journaux sont dans les colonnes).

Je devrais donc obtenir pour chaque compte une décomposition de son solde par journal comptable.
Mais les soldes de pas mal de comptes sont doublés.

Ca ne se produit pas que sur ce programme. Je veux dire que les dossiers à problème restent à problème sur d'autres programmes que j'ai fait (là aussi certaines lectures se font en double).

Par contre, le logiciel comptable principal qui créé et utilise les bases access n'a pas le problème.

Oui mais mes programmes marchent sans problème sur certains dossiers ...
:(

Merci ...
_______________________________________________________________
Public Sub Déconsolide()
AnDeb = CInt(Déconso.AnnéeDébut.Text)
AnFin = CInt(Déconso.AnnéeFin.Text)
AnDC = Year(Déconso.DateClot.Value)
MaDateClot = Year(Déconso.DateClot.Value) & Right("0" & Month(Déconso.DateClot.Value), 2) & Right("0" & Day(Déconso.DateClot.Value), 2)
NbInt = Menu.MesDossiers.Rows.Count
OuvreFichiers()

For MonInt As Integer = 0 To NbInt - 1 ' DEBUT DU PARCOURS DES INTERVENANTS SELECTIONNES
For AnCours As Integer = AnDeb To AnFin
System.Windows.Forms.Application.DoEvents()
Déconso.Suivi.Text = CStr(Menu.MesDossiers.Rows(MonInt).Cells(1).Value) & " " & AnCours
CodId = CStr(Menu.MesDossiers.Rows(MonInt).Cells(0).Value)
'on va lire le fichier Quadra correspondant à l'année et à la société
If AnCours < AnDC Then
NomFic = RepDosArc & AnCours & "\" & CodId & "\qcompta.mdb"
Else
NomFic = RepDos & CodId & "\qcompta.mdb"
End If
' on teste si le fichier existe
If FileExists(NomFic) = True Then 'si on ne trouve pas le fichier on poursuit
OuvreFichiersComptables()
If FeuilleExiste("Déc" & CodId & AnCours) = False Then
SheetC = CType(WBook.Worksheets.Add(), Worksheet)
SheetC.Name = "Déc" & CodId & AnCours
Else
SheetC = CType(WBook.Worksheets("Déc" & CodId & AnCours), Worksheet) ' ON SE POSITIONNE SUR LA FEUILLE CONSO
SheetC.Cells.Clear()
End If
LastRang = 1 ' on en est à la 1ère rangée de la feuille
LastCol = 2
MonCpte = ""
CType(SheetC.Cells(1, 1), Excel.Range).Value = CodId & " " & AnCours
' Parcours fichier Ecritures
While Not rsEcr.EOF
MaDate = Mid(CStr(rsEcr("PeriodeEcriture").Value), 5, 8) & Mid(CStr(rsEcr("PeriodeEcriture").Value), 3, 4) & _
Right("0" & CStr(rsEcr("JourEcriture").Value), 2)
If MaDateClot >= MaDate Then 'il faut traiter cette écriture
MonSolde = Val(rsEcr("MontantTenuDebit").Value) - Val(rsEcr("MontantTenuCredit").Value)
If MonCpte <> CStr(rsEcr("NumeroCompte").Value) Then ' c'est un nouveau compte
LastRang = LastRang + 1
MonCpte = CStr(rsEcr("NumeroCompte").Value)
CType(SheetC.Cells(LastRang, 1), Excel.Range).NumberFormat = "@"
CType(SheetC.Cells(LastRang, 1), Excel.Range).Value = MonCpte
rsCom.Find("Numero ='" & MonCpte & "'", , ADODB.SearchDirectionEnum.adSearchForward, 1)
CType(SheetC.Cells(LastRang, 2), Excel.Range).Value = Left(CStr(rsCom("Intitule").Value), 25)
End If
If Déconso.Folio.Checked = True Then 'on veut distinguer les folios
MonJournal = CStr(rsEcr("CodeJournal").Value) & CStr(rsEcr("Folio").Value)
Else
MonJournal = CStr(rsEcr("CodeJournal").Value)
End If
'on cherche le journal dans la 1ère rangée
Try
ColTrouve = CInt(XlsApp.WorksheetFunction.Match(MonJournal, SheetC.Rows(1), 0))
'le journal existe
CType(SheetC.Cells(LastRang, ColTrouve), Excel.Range).Value = Val(CType(SheetC.Cells(LastRang, ColTrouve), Excel.Range).Value) + MonSolde
Catch 'le journal n'existe pas, on va le rajouter à droite en colonne
LastCol = LastCol + 1
CType(SheetC.Cells(1, LastCol), Excel.Range).Value = MonJournal
CType(SheetC.Cells(LastRang, LastCol), Excel.Range).Value = Val(CType(SheetC.Cells(LastRang, LastCol), Excel.Range).Value) + MonSolde
End Try
End If
rsEcr.MoveNext()
End While 'fin parcours écritures
If LastCol > 3 Then ' il y a au moins 2 journaux
'trier par rangée 1
MyRange = SheetC.Range(SheetC.Cells(1, 3), SheetC.Cells(LastRang, LastCol))
MyRange.Sort( _
Key1:=SheetC.Range("C1"), _
Order1:=Excel.XlSortOrder.xlAscending, _
Header:=Excel.XlYesNoGuess.xlGuess, _
Orientation:=Excel.XlSortOrientation.xlSortRows, _
DataOption1:=Excel.XlSortDataOption.xlSortTextAsNumbers)
End If
' on cherche la première rangée de compte de résultat
For i As Integer = 2 To LastRang
If CStr(CType(SheetC.Cells(i, 1), Excel.Range).Value) > "59999999" Then
DebRngRest = i 'c'est la première ligne du compte de résultat
Exit For
End If
Next
'calculer les totaux par colonne (comptes de résultat)
CType(SheetC.Cells(LastRang + 1, 2), Excel.Range).Value = "Résultat net"
If DebRngRest > 0 Then 'il y a au moins un compte de résultat
For i As Integer = 3 To LastCol + 1 'total par colonne
CType(SheetC.Cells(LastRang + 1, i), Excel.Range).Formula = "=Sum(" & CType(SheetC.Cells(DebRngRest, i), Excel.Range).Address(0, 0) & _
":" & CType(SheetC.Cells(LastRang, i), Excel.Range).Address(0, 0) & ")"
Next
Else ' pas de compte de résultat
For i As Integer = 3 To LastCol + 1 'total par colonne
CType(SheetC.Cells(LastRang + 1, i), Excel.Range).Value = 0
Next
End If
' calculer les totaux par ligne
SheetC.Cells(1, LastCol + 1) = "Total"
For i As Integer = 2 To LastRang 'total par lignes
CType(SheetC.Cells(i, LastCol + 1), Excel.Range).Formula = "=Sum(" & CType(SheetC.Cells(i, 3), Excel.Range).Address(0, 0) & _
":" & CType(SheetC.Cells(i, LastCol), Excel.Range).Address(0, 0) & ")"
Next
' formatage général
With SheetC.Cells.Font
.Name = "Calibri"
.Size = 8
End With
'1ère rangée
SheetC.Range(SheetC.Cells(1, 1), SheetC.Cells(1, LastCol + 1)).Borders.LineStyle = Excel.XlLineStyle.xlContinuous
SheetC.Range(SheetC.Cells(1, 1), SheetC.Cells(1, LastCol + 1)).HorizontalAlignment = Excel.Constants.xlCenter
'1ère colonne
SheetC.Range(SheetC.Cells(2, 1), SheetC.Cells(LastRang + 1, 1)).HorizontalAlignment = Excel.Constants.xlCenter
SheetC.Range(SheetC.Cells(2, 1), SheetC.Cells(LastRang, 1)).BorderAround2(LineStyle:=Excel.XlLineStyle.xlContinuous)
' dernière rangée
SheetC.Range(SheetC.Cells(LastRang + 1, 1), SheetC.Cells(LastRang + 1, LastCol + 1)).Borders.LineStyle = Excel.XlLineStyle.xlContinuous
' dernière colonne
SheetC.Range(SheetC.Cells(2, LastCol + 1), SheetC.Cells(LastRang, LastCol + 1)).BorderAround2(LineStyle:=Excel.XlLineStyle.xlContinuous)
'toutes les colonnes de données
SheetC.Range(SheetC.Cells(2, 3), SheetC.Cells(LastRang + 1, LastCol + 1)).HorizontalAlignment = Excel.Constants.xlRight
SheetC.Range(SheetC.Cells(2, 3), SheetC.Cells(LastRang + 1, LastCol + 1)).NumberFormatLocal = "# ##0,00"
'Largeurs
CType(SheetC.Cells(1, 1), Excel.Range).ColumnWidth = 9
CType(SheetC.Cells(1, 2), Excel.Range).ColumnWidth = 15
SheetC.Range(SheetC.Cells(1, 3), SheetC.Cells(1, LastCol)).ColumnWidth = 10
SheetC.Range(SheetC.Cells(1, LastCol + 1), SheetC.Cells(1, LastCol + 1)).ColumnWidth = 10
' figer la fenêtre
SheetC.Application.ActiveWindow.SplitRow = 1
SheetC.Application.ActiveWindow.SplitColumn = 2
SheetC.Application.ActiveWindow.FreezePanes = True
FermeFichiersComptables()
End If
Next 'année
Next 'intervenant
FermeFichiers()
Déconso.Close()
End Sub
___________________________________________________________
Sub OuvreFichiers()
If Not cnQGI.State = ConnectionState.Open Then
' on ouvre le fichier QGI
If FileExists(FicPerm) = False Then
MsgBox("Le ficher " & FicPerm & "n'est pas trouvé")
Exit Sub
End If
cnQGI.Open("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & FicPerm & ";")
End If
If Not rsInt.State = ConnectionState.Open Then
With rsInt
.ActiveConnection = cnQGI
.Open("SELECT * FROM Intervenants order by Code", , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adlockoptimistic, ADODB.CommandTypeEnum.adCmdText)
End With
End If
If Not rsDir.State = ConnectionState.Open Then
With rsDir
.ActiveConnection = cnQGI
.Open("SELECT * FROM Dirigeants order by CodeDirigeant", , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
End With
End If
If Not rsAnn.State = ConnectionState.Open Then
With rsAnn
.ActiveConnection = cnQGI
.Open("SELECT * FROM Annexe order by Texte2", , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
End With
End If
If Not rsFis.State = ConnectionState.Open Then
With rsFis
.ActiveConnection = cnQGI
.Open("SELECT * FROM Fiscal order by CodeClient", , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
End With
End If
If Not rsCli.State = ConnectionState.Open Then
With rsCli
.ActiveConnection = cnQGI
.Open("SELECT * FROM Clients order by Code", , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
End With
End If
If Not rsAct.State = ConnectionState.Open Then
With rsAct
.ActiveConnection = cnQGI
.Open("SELECT * FROM Activites order by Code", , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
End With
End If
If Not rsCiv.State = ConnectionState.Open Then
With rsCiv
.ActiveConnection = cnQGI
.Open("SELECT * FROM Civilites order by Code", , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
End With
End If
End Sub
____________________________________________________________
Sub OuvreFichiersComptables()
' on teste si le fichier existe
If FileExists(NomFic) = True Then
cnDC.Open("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & NomFic & ";")
If Not rsDos.State = ConnectionState.Open Then
With rsDos
.ActiveConnection = cnDC
.Open("SELECT * FROM Dossier1 order by RaisonSociale", , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
End With
End If
If Not rsCom.State = ConnectionState.Open Then
With rsCom
.ActiveConnection = cnDC
.Open("SELECT * FROM Comptes order by Numero", , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
End With
End If
If Not rsEcr.State = ConnectionState.Open Then
With rsEcr
.ActiveConnection = cnDC
.Open("SELECT * FROM Ecritures ORDER by NumeroCompte,PeriodeEcriture,JourEcriture", , ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
End With
End If
If Not rsCBo.State = ConnectionState.Open Then
With rsCBo
.ActiveConnection = cnDC
.Open("SELECT * FROM CreditsBails ORDER by NumeroCompte,Numero", , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
End With
End If
If Not rsTab.State = ConnectionState.Open Then
With rsTab
.ActiveConnection = cnDC
.Open("SELECT * FROM TableauxPaiements ORDER by NumeroCB,NumLigne", , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
End With
End If
Else ' on ne fait rien
End If
End Sub
___________________________________________________________
Sub FermeFichiers()
If rsInt.State = 1 Then
rsInt.Close()
End If
If rsAnn.State = 1 Then
rsAnn.Close()
End If
If rsDir.State = 1 Then
rsDir.Close()
End If
If rsFis.State = 1 Then
rsFis.Close()
End If
If rsCli.State = 1 Then
rsCli.Close()
End If
If rsAct.State = 1 Then
rsAct.Close()
End If
If rsCiv.State = 1 Then
rsCiv.Close()
End If
If cnQGI.State = 1 Then
cnQGI.Close()
End If
End Sub
________________________________________________________________
Sub FermeFichiersComptables()
If rsEcr.State = 1 Then
rsEcr.Close()
End If
If rsCom.State = 1 Then
rsCom.Close()
End If
If rsDos.State = 1 Then
rsDos.Close()
End If
If rsCBo.State = 1 Then
rsCBo.Close()
End If
If rsTab.State = 1 Then
rsTab.Close()
End If
If cnDC.State = 1 Then
cnDC.Close()
End If
End Sub

Ouch ... Peux-tu mettre ton code dans les balises CODE (logo # dans l'éditeur), et si possible, qu'il soit indenté ? (Je suis embêtant mais là c'est pas très très lisible ... ) :mrgreen:

Et nous donner vraiment le max d'infos sur la structure générale (en diagonale, je vois de l'Excel, de l'Access, et tu parles en plus d'un logiciel comptable qui gère les bases Acces ... Je suis un peu perdu :P )
Ne sois pas radin sur les explications ! ;)

Voilà...
J'espère que ce sera plus lisible comme ça.

Le logiciel "principal" n'a rien à voir avec ma programmation.
C'est juste pour dire que le problème de double lecture est peut-être lié à ma façon d'accéder aux enregistrements de la table Access.

J'ai essayé de "réparer" la base access (les index) avec un utilitaire mais ça n'a rien changé. Certains enregistrements continuent à être lus deux fois.
Les mêmes, de façon constante ...

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
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
 
Public Sub Déconsolide()
        AnDeb = CInt(Déconso.AnnéeDébut.Text)
        AnFin = CInt(Déconso.AnnéeFin.Text)
        AnDC = Year(Déconso.DateClot.Value)
        MaDateClot = Year(Déconso.DateClot.Value) & Right("0" & Month(Déconso.DateClot.Value), 2) & Right("0" & Day(Déconso.DateClot.Value), 2)
        NbInt = Menu.MesDossiers.Rows.Count
        OuvreFichiers()
 
        For MonInt As Integer = 0 To NbInt - 1 ' DEBUT DU PARCOURS DES INTERVENANTS SELECTIONNES
            For AnCours As Integer = AnDeb To AnFin
                System.Windows.Forms.Application.DoEvents()
                Déconso.Suivi.Text = CStr(Menu.MesDossiers.Rows(MonInt).Cells(1).Value) & " " & AnCours
                CodId = CStr(Menu.MesDossiers.Rows(MonInt).Cells(0).Value)
                'on va lire le fichier Quadra correspondant à l'année et à la société
                If AnCours < AnDC Then
                    NomFic = RepDosArc & AnCours & "\" & CodId & "\qcompta.mdb"
                Else
                    NomFic = RepDos & CodId & "\qcompta.mdb"
                End If
                ' on teste si le fichier existe
                If FileExists(NomFic) = True Then 'si on ne trouve pas le fichier on poursuit 
                    OuvreFichiersComptables()
                    If FeuilleExiste("Déc" & CodId & AnCours) = False Then
                        SheetC = CType(WBook.Worksheets.Add(), Worksheet)
                        SheetC.Name = "Déc" & CodId & AnCours
                    Else
                        SheetC = CType(WBook.Worksheets("Déc" & CodId & AnCours), Worksheet) ' ON SE POSITIONNE SUR LA FEUILLE CONSO
                        SheetC.Cells.Clear()
                    End If
                    LastRang = 1 ' on en est à la 1ère rangée de la feuille
                    LastCol = 2
                    MonCpte = ""
                    CType(SheetC.Cells(1, 1), Excel.Range).Value = CodId & " " & AnCours
                    ' Parcours fichier Ecritures
                    While Not rsEcr.EOF
                        MaDate = Mid(CStr(rsEcr("PeriodeEcriture").Value), 5, 8) & Mid(CStr(rsEcr("PeriodeEcriture").Value), 3, 4) & _
                            Right("0" & CStr(rsEcr("JourEcriture").Value), 2)
                        If MaDateClot >= MaDate Then 'il faut traiter cette écriture
                            MonSolde = Val(rsEcr("MontantTenuDebit").Value) - Val(rsEcr("MontantTenuCredit").Value)
                            If MonCpte <> CStr(rsEcr("NumeroCompte").Value) Then ' c'est un nouveau compte
                                LastRang = LastRang + 1
                                MonCpte = CStr(rsEcr("NumeroCompte").Value)
                                CType(SheetC.Cells(LastRang, 1), Excel.Range).NumberFormat = "@"
                                CType(SheetC.Cells(LastRang, 1), Excel.Range).Value = MonCpte
                                rsCom.Find("Numero ='" & MonCpte & "'", , ADODB.SearchDirectionEnum.adSearchForward, 1)
                                CType(SheetC.Cells(LastRang, 2), Excel.Range).Value = Left(CStr(rsCom("Intitule").Value), 25)
                            End If
                            If Déconso.Folio.Checked = True Then 'on veut distinguer les folios
                                MonJournal = CStr(rsEcr("CodeJournal").Value) & CStr(rsEcr("Folio").Value)
                            Else
                                MonJournal = CStr(rsEcr("CodeJournal").Value)
                            End If
                            'on cherche le journal dans la 1ère rangée
                            Try
                                ColTrouve = CInt(XlsApp.WorksheetFunction.Match(MonJournal, SheetC.Rows(1), 0))
                                'le journal existe
                                CType(SheetC.Cells(LastRang, ColTrouve), Excel.Range).Value = Val(CType(SheetC.Cells(LastRang, ColTrouve), Excel.Range).Value) + MonSolde
                            Catch 'le journal n'existe pas, on va le rajouter à droite en colonne
                                LastCol = LastCol + 1
                                CType(SheetC.Cells(1, LastCol), Excel.Range).Value = MonJournal
                                CType(SheetC.Cells(LastRang, LastCol), Excel.Range).Value = Val(CType(SheetC.Cells(LastRang, LastCol), Excel.Range).Value) + MonSolde
                            End Try
                        End If
                        rsEcr.MoveNext()
                    End While 'fin parcours écritures
                    If LastCol > 3 Then ' il y a au moins 2 journaux
                        'trier par rangée 1
                        MyRange = SheetC.Range(SheetC.Cells(1, 3), SheetC.Cells(LastRang, LastCol))
                        MyRange.Sort( _
                         Key1:=SheetC.Range("C1"), _
                         Order1:=Excel.XlSortOrder.xlAscending, _
                         Header:=Excel.XlYesNoGuess.xlGuess, _
                         Orientation:=Excel.XlSortOrientation.xlSortRows, _
                         DataOption1:=Excel.XlSortDataOption.xlSortTextAsNumbers)
                    End If
                    ' on cherche la première rangée de compte de résultat
                    For i As Integer = 2 To LastRang
                        If CStr(CType(SheetC.Cells(i, 1), Excel.Range).Value) > "59999999" Then
                            DebRngRest = i 'c'est la première ligne du compte de résultat
                            Exit For
                        End If
                    Next
                    'calculer les totaux par colonne (comptes de résultat)
                    CType(SheetC.Cells(LastRang + 1, 2), Excel.Range).Value = "Résultat net"
                    If DebRngRest > 0 Then 'il y a au moins un compte de résultat
                        For i As Integer = 3 To LastCol + 1 'total par colonne
                            CType(SheetC.Cells(LastRang + 1, i), Excel.Range).Formula = "=Sum(" & CType(SheetC.Cells(DebRngRest, i), Excel.Range).Address(0, 0) & _
                            ":" & CType(SheetC.Cells(LastRang, i), Excel.Range).Address(0, 0) & ")"
                        Next
                    Else ' pas de compte de résultat
                        For i As Integer = 3 To LastCol + 1 'total par colonne
                            CType(SheetC.Cells(LastRang + 1, i), Excel.Range).Value = 0
                        Next
                    End If
                    ' calculer les totaux par ligne
                    SheetC.Cells(1, LastCol + 1) = "Total"
                    For i As Integer = 2 To LastRang 'total par lignes
                        CType(SheetC.Cells(i, LastCol + 1), Excel.Range).Formula = "=Sum(" & CType(SheetC.Cells(i, 3), Excel.Range).Address(0, 0) & _
                        ":" & CType(SheetC.Cells(i, LastCol), Excel.Range).Address(0, 0) & ")"
                    Next
                    ' formatage général
                    With SheetC.Cells.Font
                        .Name = "Calibri"
                        .Size = 8
                    End With
                    '1ère rangée
                    SheetC.Range(SheetC.Cells(1, 1), SheetC.Cells(1, LastCol + 1)).Borders.LineStyle = Excel.XlLineStyle.xlContinuous
                    SheetC.Range(SheetC.Cells(1, 1), SheetC.Cells(1, LastCol + 1)).HorizontalAlignment = Excel.Constants.xlCenter
                    '1ère colonne
                    SheetC.Range(SheetC.Cells(2, 1), SheetC.Cells(LastRang + 1, 1)).HorizontalAlignment = Excel.Constants.xlCenter
                    SheetC.Range(SheetC.Cells(2, 1), SheetC.Cells(LastRang, 1)).BorderAround2(LineStyle:=Excel.XlLineStyle.xlContinuous)
                    ' dernière rangée
                    SheetC.Range(SheetC.Cells(LastRang + 1, 1), SheetC.Cells(LastRang + 1, LastCol + 1)).Borders.LineStyle = Excel.XlLineStyle.xlContinuous
                    ' dernière colonne
                    SheetC.Range(SheetC.Cells(2, LastCol + 1), SheetC.Cells(LastRang, LastCol + 1)).BorderAround2(LineStyle:=Excel.XlLineStyle.xlContinuous)
                    'toutes les colonnes de données
                    SheetC.Range(SheetC.Cells(2, 3), SheetC.Cells(LastRang + 1, LastCol + 1)).HorizontalAlignment = Excel.Constants.xlRight
                    SheetC.Range(SheetC.Cells(2, 3), SheetC.Cells(LastRang + 1, LastCol + 1)).NumberFormatLocal = "# ##0,00"
                    'Largeurs
                    CType(SheetC.Cells(1, 1), Excel.Range).ColumnWidth = 9
                    CType(SheetC.Cells(1, 2), Excel.Range).ColumnWidth = 15
                    SheetC.Range(SheetC.Cells(1, 3), SheetC.Cells(1, LastCol)).ColumnWidth = 10
                    SheetC.Range(SheetC.Cells(1, LastCol + 1), SheetC.Cells(1, LastCol + 1)).ColumnWidth = 10
                    ' figer la fenêtre
                    SheetC.Application.ActiveWindow.SplitRow = 1
                    SheetC.Application.ActiveWindow.SplitColumn = 2
                    SheetC.Application.ActiveWindow.FreezePanes = True
                    FermeFichiersComptables()
                End If
            Next 'année
        Next 'intervenant
        FermeFichiers()
        Déconso.Close()
    End Sub
  Sub OuvreFichiersComptables()
        ' on teste si le fichier existe
        If FileExists(NomFic) = True Then
            cnDC.Open("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & NomFic & ";")
            If Not rsDos.State = ConnectionState.Open Then
                With rsDos
                    .ActiveConnection = cnDC
                    .Open("SELECT * FROM Dossier1 order by RaisonSociale", , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
                End With
            End If
            If Not rsCom.State = ConnectionState.Open Then
                With rsCom
                    .ActiveConnection = cnDC
                    .Open("SELECT * FROM Comptes order by Numero", , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
                End With
            End If
            If Not rsEcr.State = ConnectionState.Open Then
                With rsEcr
                    .ActiveConnection = cnDC
                    .Open("SELECT * FROM Ecritures ORDER by NumeroCompte,PeriodeEcriture,JourEcriture", , ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
                End With
            End If
            If Not rsCBo.State = ConnectionState.Open Then
                With rsCBo
                    .ActiveConnection = cnDC
                    .Open("SELECT * FROM CreditsBails ORDER by NumeroCompte,Numero", , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
                End With
            End If
            If Not rsTab.State = ConnectionState.Open Then
                With rsTab
                    .ActiveConnection = cnDC
                    .Open("SELECT * FROM TableauxPaiements ORDER by NumeroCB,NumLigne", , ADODB.CursorTypeEnum.adOpenDynamic, ADODB.LockTypeEnum.adLockOptimistic, ADODB.CommandTypeEnum.adCmdText)
                End With
            End If
        Else ' on ne fait rien
        End If
    End Sub
    Sub FermeFichiers()
        If rsInt.State = 1 Then
            rsInt.Close()
        End If
        If rsAnn.State = 1 Then
            rsAnn.Close()
        End If
        If rsDir.State = 1 Then
            rsDir.Close()
        End If
        If rsFis.State = 1 Then
            rsFis.Close()
        End If
        If rsCli.State = 1 Then
            rsCli.Close()
        End If
        If rsAct.State = 1 Then
            rsAct.Close()
        End If
        If rsCiv.State = 1 Then
            rsCiv.Close()
        End If
        If cnQGI.State = 1 Then
            cnQGI.Close()
        End If
    End Sub
    Sub FermeFichiersComptables()
        If rsEcr.State = 1 Then
            rsEcr.Close()
        End If
        If rsCom.State = 1 Then
            rsCom.Close()
        End If
        If rsDos.State = 1 Then
            rsDos.Close()
        End If
        If rsCBo.State = 1 Then
            rsCBo.Close()
        End If
        If rsTab.State = 1 Then
            rsTab.Close()
        End If
        If cnDC.State = 1 Then
            cnDC.Close()
        End If
    End Sub

Pffffffff
Après des heures de recherche ... j'ai fini par penser à ouvrir les bases de données à problème avec microsoft access et il s'avère que les lignes en double sont bien présentes dans la base de données.

Elles portent un code particulier qui permet de les exclure de la lecture.

Merci pour ceux qui se sont penchés sur mon problème et mes excuses ...

Je suis content que tu ais trouvé, j'avais omis ce sujet et je ne m'y serais penché qu'aujourd'hui. :oops:

Et si c'était un problème de données, j'aurais ragé d'avoir épluché tout ton code. :mouarf:

Bonne continuation.