Fermeture fichiers txt non actifs excel [Résolu]

[Scrabblouille]

Bonjour,

Le but de ma macro est d'ouvrir plusieurs fichiers txt issus d'un système de radiocommunications et de compiler les infos dans un fichier excel unique afin de les traiter à l'aide d'une macro.
Pour l'ouverture, le choix des fichiers et la compilation je n'ai pas de souci.
La où je coince c'est pour la fermeture des fichiers txt.
Ci-dessous mon code

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
Sub Ouverture_TXT()
Dim lignefin As Integer
 
Fichiers = Application.GetOpenFilename("Fichiers Texte (*.txt), *.txt", , , , True)
 
If IsArray(Fichiers) Then
    For i = LBound(Fichiers, 1) To UBound(Fichiers, 1)
        Workbooks.OpenText Fichiers(i) _
        , Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1)), _
        TrailingMinusNumbers:=True
 
        lignefin = ActiveSheet.UsedRange.Rows.Count
        Range("A3:H" & lignefin - 1).Copy
        Windows("Utilisation_postes.xls").Activate
        lignefin = ActiveSheet.UsedRange.Rows.Count
        Range("A" & lignefin + 2).Select
        ActiveSheet.Paste
        Cells.EntireColumn.autofit
    Next i
Else
Exit Sub
End If
 
End Sub

J'ai essayé de mettre

Code :

activewindow.close

après ma commande copy mais je n'arrive pas à forcer la fenêtre qui me demande si je veux garder les donnés de mon presse papier.

J'ai également essayé des choses du type

Code :

1
2
Fichiers(i).activate
Fichiers(i).close

mais cela ne fonctionne pas.

Si quelqu'un(e) avait une idée à me soumettre ce serait vraiment sympa.

Amicalement

[Scrabblouille]

Re-bonjour,

Je viens de trouver un début de solution

Code :

1
2
Nomfichier = Mid(fichiers(i), InStrRev(fichiers(i), "\") + 1)
        Windows(Nomfichier).Close

La seule chose ou je coince encore est donc de savoir comment répondre automatiquement à la question concernant le presse papier.

Cdlt.

[jfontaine]

Bonjour,

Je n'ai pas testé, mais je pense qu'en ajoutant une variable Workbook correspondant au fichier Texte ouvert se sera plus facile a manipuler

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
Sub Ouverture_TXT()
Dim lignefin As Integer
Dim wrk As Workbook
 
Fichiers = Application.GetOpenFilename("Fichiers Texte (*.txt), *.txt", , , , True)
 
If IsArray(Fichiers) Then
    For i = LBound(Fichiers, 1) To UBound(Fichiers, 1)
 
 
        Workbooks.OpenText Fichiers(i) _
            , Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
            xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
            Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
            Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1)), _
            TrailingMinusNumbers:=True
 
        Set wrk = ActiveWorkbook
 
 
        lignefin = ActiveSheet.UsedRange.Rows.Count
        Range("A3:H" & lignefin - 1).Copy
        Windows("Utilisation_postes.xls").Activate
        lignefin = ActiveSheet.UsedRange.Rows.Count
        Range("A" & lignefin + 2).Select
        ActiveSheet.Paste
        Cells.EntireColumn.AutoFit
 
        Application.DisplayAlerts = False
        wrk.Close False
        Application.DisplayAlerts = True
 
    Next i
 
End If
 
End Sub

DisplayAlert permet de désactiver les messages d'erreurs

[mercatog]

Bonjour
En complément du code amélioré par jfontaine, ci joint proposition sans les Activate, Select i Windows...

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
Sub Ouverture_TXT()
Dim LigneFin As Long, NewLig As Long
Dim i As Integer
Dim Wrk As Workbook
Dim Sh As Worksheet
Dim Fichiers
 
Application.ScreenUpdating = False
Fichiers = Application.GetOpenFilename("Fichiers Texte (*.txt), *.txt", , , , True)
If IsArray(Fichiers) Then
    Set Sh = ThisWorkbook.Worksheets("Feuil1")             'A adapter selon la feuille destination de l'import des données
    For i = LBound(Fichiers) To UBound(Fichiers)
        NewLig = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row + 2
 
        Workbooks.OpenText Filename:=Fichiers(i), Origin:=xlMSDOS, _
                           DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                           ConsecutiveDelimiter:=False, Tab:=True, Comma:=True, _
                           FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), _
                                            Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1)), _
                                            TrailingMinusNumbers:=True
 
        Set Wrk = ActiveWorkbook
        With Wrk.Sheets(1)
            LigneFin = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
            If LigneFin >= 3 Then .Range("A3:H" & LigneFin).Copy Sh.Range("A" & NewLig)
        End With
 
        Application.DisplayAlerts = False
        Wrk.Close False
        Application.DisplayAlerts = True
        Set Wrk = Nothing
    Next i
    Sh.UsedRange.EntireColumn.AutoFit
    Set Sh = Nothing
End If
End Sub

[Scrabblouille]

Bonsoir,

Merci pour vos réponses.

Le "False" après le close répondait à ma question mais en bonus vous m'avez apporté des améliorations.

C'est très sympa de votre part.

Amicalement