Reproduire un même traitement sur les autres fichiers texte d'un dossier

**capi81** · 10/06/2015, 20h38

Salut le forum

Je souhaite reproduire un même traitement sur les autres fichiers texte qui se trouvent dans mon dossier.
Je suis passé par l'enregistreur pour réaliser le code ci-dessous pour un fichier texte de mon dossier.
Le code à me proposer devra importer les autres fichiers et faire le traitement demandé et coller le résultat sur une feuille.
Si possible je souhaite que le nom de la feuille soit tiré du nom du fichier texte (les 5 derniers chiffres du fichier) sachant que le nom du fichier suit cette logique

Code :

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

ebilncgag01000

c'est à dire que les 5 derniers chiffres se terminent par des chiffres (5).
Ci-dessous le code:

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
Sub traitement()
'
' traitement Macro
'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\vf002\Desktop\BILAN31052015\ebilncgag01001.rep", Destination _
        :=Range("$A$1"))
        .Name = "ebilncgag01001"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(6, 8, 6, 16, 20, 20, 20, 8, 9, 9)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("A:B,E:F").Select
    Range("E1").Activate
    ActiveWindow.SmallScroll ToRight:=2
    Range("A:B,E:F,I:K").Select
    Range("I1").Activate
    Selection.Delete Shift:=xlToLeft
    Range("A16").Select
    ActiveWindow.SmallScroll Down:=-9
    Rows("1:3").Select
    Selection.ClearContents
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("1:3").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "CODE"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "RC"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "INTITULE"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "MONTANT"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "NOMBRE"
    Range("A2").Select
    ActiveWindow.SmallScroll Down:=-9
 
End Sub

**tamtam64** · 10/06/2015, 21h09

tu met tes liens dans un dico ou un tableau
tu appel cette sub

Code :

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

1
2
3
4
5
fichier = dir(... lien avec un joker)
while fichier<> ""
call tafonction
fichier = dir
wend

En fait cette sub parcours ton fichier . Au niveau du lien tu dois mettre un ou deux joker ( une etoile ) dsl j'ai in pb avec mon clavier mais c'est l'etoile.
etu fait la meme fonction mais avec un parametre lien en parametre pour pouvoir l'utiliser dans cette boucle .

Si tu n'y arrive pas reviens , je vais developper, le temps de brancher un clavier

**capi81** · 19/06/2015, 18h10

Bonsoir TAMTAM64

Je m'excuse du temps mis car j'avais un empêchement.
Voici ce que j'ai pu réaliser mais je rencontre un débogage (absence de boucle).

Code :

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

1
2
3
4
5
6
7
8
9
Sub traitement_fichier()
Dim Fichier As String
Fichier = Dir(Sheets("Menu").Range("B7").Value & "\*.rep")
If Fichier = "" Then MsgBox "Aucun fichier de type .rep dans le répertoire sélectionné"
Do While Fichier <> ""
Application.StatusBar = "Traitement en cours : " & Fichier
Call Traitement
'Fichier = Dir
End Sub

Merci de m'aider

Invité · 19/06/2015, 19h48

Bonsoir,
Call Traitement(Fichier)

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
Sub traitement(Fichier as string)
'
' traitement Macro
'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & Fichier;Destination _
        :=Range("$A$1"))
        .Name = "ebilncgag01001"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(6, 8, 6, 16, 20, 20, 20, 8, 9, 9)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("A:B,E:F").Select
    Range("E1").Activate
    ActiveWindow.SmallScroll ToRight:=2
    Range("A:B,E:F,I:K").Select
    Range("I1").Activate
    Selection.Delete Shift:=xlToLeft
    Range("A16").Select
    ActiveWindow.SmallScroll Down:=-9
    Rows("1:3").Select
    Selection.ClearContents
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("1:3").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "CODE"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "RC"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "INTITULE"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "MONTANT"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "NOMBRE"
    Range("A2").Select
    ActiveWindow.SmallScroll Down:=-9
 
End Sub

**capi81** · 22/06/2015, 19h21

Bonsoir rdurupt et le forum

Merci pour votre solution.
Je l'ai collé mais cette partie est sélectionnée en rouge

Code :

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

1
2
3
With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & Fichier;Destination _
        :=Range("$A$1"))

Je ne sais pas pourquoi.

**capi81** · 13/07/2015, 19h09

Bonsoir à tous

Je suis passé par l'enregistreur pour réaliser ce que je pouvais.
Tout n'est pas automatisé mais j'ai pu résoudre considérablement le temps de traitement.
Pour cela je clôture le sujet.

Reproduire un même traitement sur les autres fichiers texte d'un dossier [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager