Onglets temporaires qui ne s'effacent pas après l'exécution de la Macro

**Seth2** · 28/08/2016, 21h55

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 !

**Philippe Tulliez** · 28/08/2016, 22h09

Bonjour,
Es-tu certain de la casse ?
Pour éviter ce type de problème, force la minuscule ou la majuscule du nm de l'onglet

Exemple

Code :

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

 If Left(LCase(Worksheets(1).Name), 9) = "trimestre" Then .........

**Seth2** · 28/08/2016, 22h36

Malheureusement la minuscule ou majuscule n'y change pas grand chose. Le problème c'est que quand je précise "OngTemp" :

Code :

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

If Left(oWBFinal.Worksheets(iOnglet).Name, 7) = "OngTemp" Or "Adr_s" Then

Il reste un onglet "OngTemp2" et un onglet "Adr_s".
Mais quand je mets "ongtemp" et "adr_s" :

Code :

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

If Left(oWBFinal.Worksheets(iOnglet).Name, 7) = "ongtemp" Or "adr_s" Then

Alors je retrouve dans le fichier final les onglets "OngTemp1", "OngTemp2", "OngTemp3" et "Adr_s"

Est ce que le problème ne viendrait pas de la partie du programme qui parcourt le fichier texte ?

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

**unparia** · 28/08/2016, 23h30

Bonjour
Change ta boucle for qui fait :

Code :

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

For iOnglet = 1 To oWBFinal.Worksheets.Count

par

Code :

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

For iOnglet = oWBFinal.Worksheets.Count to 1 Step -1

car en allant de 1 à la fin, tu te fais des croche-pattes dans leur numérotation

**Seth2** · 28/08/2016, 23h35

Effectivement ca marche maintenant pour les "OngTemp", merci beaucoup

Et pour l'autre onglet "Adr_s", je fais comment ?
Comment corriger cette instruction :

Code :

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

1
2
 For iOnglet = oWBFinal.Worksheets.Count To 1 Step -1
        If Left(oWBFinal.Worksheets(iOnglet).Name, 7) = "OngTemp" Or "Adr_s" Then

Le programme me donne une erreur quand j'ajoute ' Or "Adr_s" ' .

**unparia** · 28/08/2016, 23h37

Code :

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

If Left(oWBFinal.Worksheets(iOnglet).Name, 7) = "OngTemp" Or Left(oWBFinal.Worksheets(iOnglet).Name, 5)= "Adr_s" Then

Et je ne vois pas comment tu comptes ton "7". "OngTemp" = 6 caractères et non 7 !
EDIT : excuses (je dors déjà ...) c'est bien 7 caractères.

**Seth2** · 29/08/2016, 00h27

Merci bcp pour votre aide unparia, le problème est résolu maintenant

P.S: Je comprends parfaitement

**eriiic** · 29/08/2016, 10h49

Bonjour,

Tu pouvais aussi travailler sur la collection :

Code :

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

For Each sh In Worksheets

C'est une bonne habitude ;-)
eric

**unparia** · 29/08/2016, 10h54

Bonjour Eriic
C'est certain.
Je vais quant à moi plus loin encore, dans ce genre de cas : je mets dans un array (déclaré dans la partie déclarative) les objets que je crée (j'utilise au besoin Redim Préserve) au fur et à mesure de leur création
Je traite ensuite les objets de cet array comme je l'entends
Mais j'ai voulu ici simplement corriger ce qui avait été écrit, en en gardant la "philosophie

**Seth2** · 29/08/2016, 13h06

eriiic je n'ai pas bien saisi ton point, peux-tu m'expliquer stp ?
unparia, quel est l'intérêt de cet array ?

N.B: Je viens de remarquer quelque chose de bizarre, il n'y a plus d'onglet temporaire "Adr_s", mais j'ai remarqué qu'il s'ajoute dans la collection à la fin de l'exécution, c'est à dire il y a une adresse "s" et son libellé correspondant est "Adr_s". D'où ca pourrait provenir ?

**unparia** · 29/08/2016, 13h14

unparia, quel est l'intérêt de cet array ?

Pure méthodologie. Rien de plus.

**eriiic** · 29/08/2016, 13h54

unparia, je m'adressais plus au demandeur pour lui montrer une autre possibilité qu'à toi . Je ne doute pas que tu connaissais ;-)

Seht2,
Worksheets est une collection.
Il souvent plus intéressant de balayer l'ensemble d'une collection avec For Each qui est prévu pour, plutôt qu'avec ses index.
Pas besoin d'interroger sa taille, plus rapide à écrire.
Pas besoin de se soucier des éventuelles suppressions en cours de route, l'ensemble sera bien passé en revue sans erreur. Alors qu'un index qui n'existe plus...

Code :

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

1
2
3
4
Dim sh As Worksheet
For Each sh In Worksheets
    Debug.Print sh.Name
Next sh

eric

Onglets temporaires qui ne s'effacent pas après l'exécution de la Macro

Macros et VBA Excel

Discussions similaires

Partager

Partager