[XL-2016] Fermeture de fichier texte sous EXCEL

Fermeture de fichier texte sous EXCEL

Bonjour,

J'ai une difficulté dans une procédure qui fonctionne. Le seul hic c'est qu'il me reste un fichier que j'ai ouvert en VBA dans Excel via la commande Workbooks.Opentext et que je n'arrive pas à fermer.
Avez-vous une idée ?

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
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
'cette macro permet d'extraire le fichier texte et de le convertir en pdf et excel pour la paie et la compta

Option Explicit
Sub MAJhors24()

On Error GoTo Err_MAJhors24

Dim IndexFichier As Integer
Dim Flag As Boolean
Dim FlagEntete As Boolean
Dim Fichier As String
Dim FichierSource As String
Dim FichierCourt As String
Dim FichierCible As String
Dim FichierSauv As String
Dim FichierComptable As String
Dim Annee As String
Dim Mois As String
Dim CheminPaie As String
Dim CheminComptable As String
Dim ContenuLigne As String
Dim ContenuLigneSuivante As String

' Ouverture d'une boîte de dialogue pour que le gestionnaire sélectionne le fichier journal des rubriques issu du SIRH à traiter

Application.ScreenUpdating = False

Flag = False
FlagEntete = False

ChDrive "S:"
ChDir "S:\02034\PAIE"
' Accède au fichier
Fichier = Application.GetOpenFilename("Fichiers textes (*.txt),*.txt", , _
    "Sélectionnez un fichier :")    'Affectation du fichier sélectionné (ici Texte) à la variable oF1

' Test si le gestionnaire a bien choisi un fichier ou s'il a appuyé sur annuler

If Fichier <> "Faux" Then

    ' Séparation du chemin et du fichier lu
    CheminPaie = Mid(Fichier, 1, InStrRev(Fichier, "\"))
    FichierSource = Mid(Fichier, InStrRev(Fichier, "\") + 1, Len(Fichier) - InStrRev(Fichier, "\") - 4)
    
    ' Récupération de l'année dans le nom du fichier lu
    Annee = Mid(Fichier, InStr(1, Fichier, "\PAIE") + 6, 4)
    'Récupération du mois dans le nom du fichier lu
    Mois = Mid(Fichier, InStr(1, Fichier, "\PAIE") + 16, 2)
    
    ' Définition du nom du dossier du mois dans le dossier COMPTABILITE
    Select Case Mois
        Case "01"
            Mois = "01 - JANVIER " & Annee
        Case "02"
            Mois = "02 - FEVRIER " & Annee
        Case "03"
            Mois = "03 - MARS " & Annee
        Case "04"
            Mois = "04 - AVRIL " & Annee
        Case "05"
            Mois = "05 - MAI " & Annee
        Case "06"
            Mois = "06 - JUIN " & Annee
        Case "07"
            Mois = "07 - JUILLET " & Annee
        Case "08"
            Mois = "08 - AOUT " & Annee
        Case "09"
            Mois = "09 - SEPTEMBRE " & Annee
        Case "10"
            Mois = "10 - OCTOBRE " & Annee
        Case "11"
            Mois = "11 - NOVEMBRE " & Annee
        Case "12"
            Mois = "12 - DECEMBRE " & Annee
    End Select
    
    ' Dérivation du nom du dossier comptable complet
    CheminComptable = Mid(Fichier, 1, InStr(1, Fichier, "\PAIE") - 1) & "\COMPTABILITE\" & Annee & "\" & Mois & "\"
    
    ' Définition du nom du fichier cible (Total Societé)
    FichierCible = FichierSource & " TOTAL SOCIETE.txt"
    
    ' On ouvre le fichier texte
    IndexFichier = FreeFile()
    Open Fichier For Input As #IndexFichier
    
    While Not EOF(IndexFichier)
    
        ' On lit le fichier texte ligne a ligne en lisant 2 lignes car la notion de "TOTAL SOCIETE apparait sur la ligne 2 de chaque page. Quand on a trouvé
        ' la 1ere occurence de "TOTAL SOCIETE", on crée le fichier de sortie (Idem que fichier source mais suffixé avec "TOTAL SOCIETE". on écrit les 2 lignes
        ' lues et on positionne le flag entete pour ne plus lire par 2 lignes et écrire chaque ligne jusqu'à la fin du fichier source
    
        If Flag = False Then
            Line Input #IndexFichier, ContenuLigne  ' lecture du fichier ligne par ligne : la variable contenuligne contient le contenu de la ligne active
            Line Input #IndexFichier, ContenuLigneSuivante  ' lecture de la ligne suivante (La notion de "TOTAL SOCIETE" apparait en ligne 2
        Else
            Line Input #IndexFichier, ContenuLigne
        End If
        
        If InStr(1, ContenuLigneSuivante, "POUR LA SOCIETE") <> 0 Then
            Flag = True
        End If
        
        If Flag = True Then
            If FlagEntete = False Then
                Open FichierCible For Output Access Write As FreeFile
                Print #2, ContenuLigne
                Print #2, ContenuLigneSuivante
                FlagEntete = True
            Else
                Print #2, ContenuLigne
            End If
        End If
    Wend
    
    Close #2
    Close #1
        
    ' On supprime l'onglet Journal_Rubrique car on va le recréer
    
    Application.DisplayAlerts = False
    Sheets("Journal Rubrique").Delete
    Application.DisplayAlerts = True
    
    ' On importe le fichier Texte
    ' Création de l'onglet journal rubrique avec conversion et mise en page txt vers excel
    Workbooks.OpenText Filename:=FichierCible, Origin:=xlMSDOS, StartRow:=3, DataType:=xlFixedWidth, FieldInfo:= _
        Array(Array(0, 1), Array(15, 1), Array(18, 1), Array(56, 1), Array(57, 1), Array(78, 1), Array(79, 1), Array(100, 1), _
        Array(101, 1), Array(122, 1), Array(123, 1)), TrailingMinusNumbers:=True
        
    Cells.Select
    Selection.Copy
    
    Windows("CRNO Fichier Compta journal rub - Base.xlsm").Activate
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = "Journal Rubrique"
    
    Range("A:A,D:D,F:F,H:H,J:K").Select
    Selection.Delete shift:=xlToLeft
    Range("A1").FormulaR1C1 = "Type"
    Range("B1").FormulaR1C1 = "Libellé rubrique"
    Range("C1").FormulaR1C1 = "Bases"
    Range("D1").FormulaR1C1 = "Montant Salarial"
    Range("E1").FormulaR1C1 = "Montant Patronal"
    Columns("A:E").EntireColumn.AutoFit
    
    Windows(FichierCible).Activate
    activewindows.Close
       
    ' Copie du journal des Rubriques
    Sheets("Journal Rubrique").Select
    Range("A1:E600").Copy
    Sheets("Journal rubriques paie").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    ' Actualisation du TCD Par CompteComptable
    Sheets("Par CompteComptable").Select
    ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotCache.Refresh
    
    ' Actualisation du TCD Pour SELFI
    Sheets("Pour SELFI").Select
    ActiveSheet.PivotTables("Tableau croisé dynamique3").PivotCache.Refresh
    
    ' Extraction du journal des rubriques à destination des gestionnaires Paie au format PDF
    Sheets("Par CompteComptable").Select
    Columns("A:I").Select
    Application.CutCopyMode = False
        
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FichierSource & ".pdf", quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    ' Sauvegarde du journal des rubriques à destination des gestionnaires Paie au format Excel
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, _
        Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
        Transpose:=False
    Columns("A:I").EntireColumn.AutoFit
    FichierSauv = Mid(FichierCible, 1, Len(FichierCible) - 4) & ".xlsx"
    ActiveWindow.Close savechanges:=True, Filename:=FichierSauv
    
    'Extraction du journal des rubriques à destination de l'outil de justification comptable au format PDF
    Sheets("Pour SELFI").Select
    Columns("A:F").Select
    Application.CutCopyMode = False
    
    FichierComptable = CheminComptable & FichierSource
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FichierComptable & ".pdf", quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        
    ' Sauvegarde du journal des rubriques à destination de l'outil de justification comptable au format Excel
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, _
        Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
        Transpose:=False
    Columns("A:F").EntireColumn.AutoFit
    FichierSauv = FichierComptable & ".xlsx"
    ActiveWindow.Close savechanges:=True, Filename:=FichierSauv
    
    ' Mise à jour des donnes d'actualisation
    Sheets("Accueil").Select
    Range("B3").Value = Now()
    Range("B5").Value = FichierSource
    
    ' Ouverture du dossier Paie
    ActiveWorkbook.FollowHyperlink CheminPaie, NewWindow:=True
    
    ActiveWorkbook.Close savechanges:=True
    
Else

    MsgBox "Sélection annulée par l'utilisateur ", vbInformation, err.Description
    
End If

Application.ScreenUpdating = True
GoTo Exit_MAJhors24
  
Err_MAJhors24:
    Select Case err.Number
        Case 5:     MsgBox "Le disque S:\ n'est pas disponible - ", vbInformation, err.Description
        Case 76:    MsgBox "Le dossier 02034\PAIE n'existe pas sur S:\ - ", vbInformation, err.Description
        Case Else:  MsgBox "Erreur de MAJ du journal des rubriques - " & err.Number, vbInformation, err.Description
    
    End Select
Exit_MAJhors24:

End Sub

J'ai mis en gras la commande qui ouvre le fichier. Je souhaiterais le fermer après la ligne 147 car je n'en ai plus besoin.
Pouvez-vous m'aider?
Par avance, merci.
David

Bonjour,

Une façon de faire est d'ajouter à la ligne 134 ceci:
Code:

1 2 3 Application.DisplayAlerts = False '--- sans cela demande confirmation Oui - Non - Annuler ActiveWindow.Close Application.DisplayAlerts = True
Cordialement.

Bonjour,
Tu déclares 150 000 variable et pas celles qui te faciliteraient la vie!

Code:

1
2
3
4
5
set MyTxt=Workbooks.Open(Text Filename:=FichierCible, Origin:=xlMSDOS, StartRow:=3, DataType:=xlFixedWidth, FieldInfo:= _
        Array(Array(0, 1), Array(15, 1), Array(18, 1), Array(56, 1), Array(57, 1), Array(78, 1), Array(79, 1), Array(100, 1), _
        Array(101, 1), Array(122, 1), Array(123, 1)), TrailingMinusNumbers:=True)
MyTxt.close false
Set MyTxt=Nothing

Citation:
Envoyé par EricDgn
Bonjour,

Une façon de faire est d'ajouter à la ligne 134 ceci:
Code:

1 2 3 Application.DisplayAlerts = False '--- sans cela demande confirmation Oui - Non - Annuler ActiveWindow.Close Application.DisplayAlerts = True
Cordialement.
Bonjour EricDgn,

J'avais essayé cette commande et j'ai une erreur 424 et le fichier ne se ferme pas.
Cordialement.

David

1 pièce(s) jointe(s)

Citation:
Envoyé par Thumb down
Bonjour,
Tu déclares 150 000 variable et pas celles qui te faciliteraient la vie!
Code:

1 2 3 4 5 set MyTxt=Workbooks.Open(Text Filename:=FichierCible, Origin:=xlMSDOS, StartRow:=3, DataType:=xlFixedWidth, FieldInfo:= _ Array(Array(0, 1), Array(15, 1), Array(18, 1), Array(56, 1), Array(57, 1), Array(78, 1), Array(79, 1), Array(100, 1), _ Array(101, 1), Array(122, 1), Array(123, 1)), TrailingMinusNumbers:=True) MyTxt.close false Set MyTxt=Nothing
Bonjour Thumb down,

J'avais essayé un truc du genre mais j'ai une erreur de l'éditeur VBA qui me surligne la ligne en rouge en sélectionnant "Filename"

Pièce jointe 580217

Cordialement.

David

Oui, c'est

Code:

Set MyTxt=Workbooks.OpenText (Filename:=FichierCible, ...

Cordialement

1 pièce(s) jointe(s)

Citation:

Envoyé par EricDgn

Oui, c'est

Code:

Set MyTxt=Workbooks.OpenText (Filename:=FichierCible, ...

Cordialement

Bonjour,

Effectivement cela passe avec des parenthèses.
Par contre, lorsque je compile le projet, j'ai ce message d'erreur

Pièce jointe 580232

Merci pour votre aide.
Cordialement.

David

Bonjour,

En fait l'instruction Workbooks.OpenText est intéressante pour ouvrir un fichier texte (csv p.ex.) mais elle n'en donne pas la référence, il faut donc le faire en 2 temps:
Code:

1 2 3 4 5 6 7 Dim mytxt As Workbook ... Workbooks.OpenText Filename:=... Set mytxt = ActiveWorkbook ... mytxt.Close False Set mytxt = Nothing
Par contre on peut faire:
Code:

1 2 3 4 5 6 Dim mytxt As Workbook ... Set mytxt = Workbooks.Open(Filename:=...) ... mytxt.Close False Set mytxt = Nothing
Cordialement.

Bonjour EricDgn,

Je te remercie pour la solution. Cela fonctionne parfaitement.
Bonne journée.

David