Bonsoir,

J'ai un soucis avec le code suivant, qui est destiné à importer des fichiers textes spéciaux et faire leur traitement, c'est à dire les trier sur plusieurs onglets selon la valeur suivant une colonne précise (Adresses). La collection, que l'utilisateur fournit, c'est en fait les valeurs "Adresses" qu'il y aura en tout, ainsi que leur "libellés".

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
Option Explicit
 
Public Sub TraitementDonnees()
 
    Dim sSource As String
    Dim oFSO As FileSystemObject
    Dim oWBFinal As Workbook
    Dim oShFinal As Worksheet
    Dim oShAdresses As Worksheet
    Dim oShTitre As Worksheet
    Dim colAdresses As Collection
    Dim iLig As Integer
    Dim iDerLig As Integer
    Dim sCodeAdr As String 'code adresse
    Dim sLibAdr As String 'libellé adresse
    Dim iOnglet As Integer
    Dim iEcr As Integer
    Dim oFic As TextStream
    Dim iCol As Integer
    Dim iNbCol As Integer
    Dim sLigne As String
    Dim bFin As Boolean
 
    sSource = Application.GetOpenFilename(, , "Fichier source")
 
    If sSource = "Faux" Or sSource = "False" Then
        Exit Sub
    End If
 
    Set oFSO = New FileSystemObject
    Set oFic = oFSO.OpenTextFile(sSource, ForReading)
 
    Set oShTitre = Worksheets("Titres")
 
    'liste des adresses
    Set oShAdresses = Worksheets("Adresses")
    Set colAdresses = New Collection
 
    iDerLig = oShAdresses.Range("A" & Rows.Count).End(xlUp).Row
    If iDerLig >= 3 Then
        For iLig = 3 To iDerLig
            colAdresses.Add oShAdresses.Range("B" & iLig).Value, CStr(oShAdresses.Range("A" & iLig).Value)
        Next iLig
    End If
 
    Set oWBFinal = Workbooks.Add
 
    For iOnglet = 1 To oWBFinal.Worksheets.Count
        oWBFinal.Worksheets(iOnglet).Name = "OngTemp" & iOnglet
    Next iOnglet
 
    Application.ScreenUpdating = False
 
    '**********************************
    'recherche de la ligne de titre
    '**********************************
    iLig = 0
    While Not bFin
        iLig = iLig + 1
        sLigne = oFic.ReadLine
        If UCase(sLigne) = "[MESSUNG]" Then
            sLigne = oFic.ReadLine
            bFin = True
        End If
    Wend
 
    iNbCol = -1
    If iLig >= 100 Then
        MsgBox "[MESSUNG] non trouvé après 100 lignes !", vbExclamation
        Exit Sub
    End If
 
    'écriture de la ligne de titre dans le fichier principal (onglet masqué)
    oShTitre.Cells.Clear
 
    iNbCol = UBound(Split(sLigne, ";"))
    For iCol = 0 To iNbCol
        oShTitre.Cells(1, iCol + 1) = Split(sLigne, ";")(iCol)
    Next iCol
 
 
    'recherche du start
 
    iLig = 0
    While Not bFin
        iLig = iLig + 1
        sLigne = oFic.ReadLine
        If UCase(sLigne) = "[START]" Then
            bFin = True
        End If
    Wend
 
    iNbCol = -1
    If iLig >= 100 Then
        MsgBox "[START] non trouvé après 100 lignes !", vbExclamation
        Exit Sub
    End If
 
 
    ' Parcours du fichier texte
 
    iLig = 1
    'For iLig = 8 To iDerLig
    While Not oFic.AtEndOfStream
        'modProgress.ShowProgress iLig, iDerLig
        sLigne = oFic.ReadLine
        'nombre de colonne (que la première fois)
        If iNbCol = -1 Then
            iNbCol = UBound(Split(sLigne, ";"))
        End If
        If UBound(Split(sLigne, ";")) <> iNbCol Then
            'ligne pas normale
            sCodeAdr = ""
        Else
            sCodeAdr = Split(sLigne, ";")(2)
        End If
        If sCodeAdr <> "" Then
            If CleExist(colAdresses, CStr(sCodeAdr)) Then
                sLibAdr = colAdresses(sCodeAdr)
            Else
                'ajoute une ligne d'adresse, libellé temporaire
                iDerLig = oShAdresses.Range("A" & Rows.Count).End(xlUp).Row + 1
                oShAdresses.Range("A" & iDerLig).Value = sCodeAdr
                sLibAdr = "Adr_" & sCodeAdr
                oShAdresses.Range("B" & iDerLig).Value = sLibAdr
                colAdresses.Add sLibAdr, CStr(sCodeAdr)
            End If
            If Not OngletExist(oWBFinal, sLibAdr) Then
                oWBFinal.Worksheets.Add Worksheets(1)
                Set oShFinal = oWBFinal.Worksheets(1)
                oShFinal.Name = sLibAdr
                Application.CutCopyMode = False
                Set oShFinal = Nothing
            End If
            Set oShFinal = oWBFinal.Worksheets(sLibAdr)
            iEcr = oShFinal.Range("C" & Rows.Count).End(xlUp).Row + 1
            For iCol = 0 To iNbCol
                oShFinal.Cells(iEcr, iCol + 1) = Split(sLigne, ";")(iCol)
            Next iCol
            Set oShFinal = Nothing
        End If
        iLig = iLig + 1
        If CLng(iLig / 500) * 500 = iLig Then
            Application.ScreenUpdating = True
            Application.ScreenUpdating = False
        End If
    Wend
 
    Application.ScreenUpdating = True
 
 
    For Each oShFinal In oWBFinal.Worksheets
 
        'copie de la ligne de titre - depuis le fichier principal (onglet masqué)
        oShTitre.Rows(1).Copy
        oShFinal.Range("A1").PasteSpecial xlPasteAll
        Application.CutCopyMode = False
 
        iDerLig = oShFinal.Range("C" & Rows.Count).End(xlUp).Row
        oShFinal.Range("C2:C" & iDerLig).Value = oShFinal.Name
    Next oShFinal
 
    For iOnglet = 1 To oWBFinal.Worksheets.Count
        If Left(oWBFinal.Worksheets(iOnglet).Name, 7) = "OngTemp" Then
            Application.DisplayAlerts = False
            oWBFinal.Worksheets(iOnglet).Delete
            Application.DisplayAlerts = True
        End If
    Next iOnglet
 
 
 
    oWBFinal.Close
 
    Set oWBFinal = Nothing
    Set oShFinal = Nothing
 
    Set oShTitre = Nothing
    Set oShAdresses = Nothing
    Set colAdresses = Nothing
    Set oFSO = Nothing
 
End Sub
Le soucis qu'il y a c'est qu'à la fin de l'exécution du programme et après que le nouveau Workbook ait été créé avec ses différents onglets correspondants aux adresses, je n'arrive pas encore à savoir pourquoi mais il reste des onglets "OngTemp" et "Adr_s" et ce malgré cette commande qu'il y a à la fin:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
For iOnglet = 1 To oWBFinal.Worksheets.Count
        If Left(oWBFinal.Worksheets(iOnglet).Name, 7) = "OngTemp" Then
            Application.DisplayAlerts = False
            oWBFinal.Worksheets(iOnglet).Delete
            Application.DisplayAlerts = True
        End If
    Next iOnglet
Toute aide serait la bienvenue, merci d'avance !