Traitement sur x fichiers

Djilow

XLDnaute Junior
Bonjour
Une fois de plus je me retrouve coincé et je viens donc faire appels à vos services :rolleyes:
Je souhaiterais faire une macro qui me permette de mettre en forme un fichier au format .csv en partant de plusieurs fichiers .xls
Je possède déjà une macro qui me fait le traitement sur un fichier mais j'aimerais l'adapter pour que celle-ci traite l'intégralité de mes fichiers

Voici la macro dont je dispose
Code:
Sub TraitementCarteLucent()
'
' TraitementCarteLucent Macro
' Macro enregistrée le 01/07/2010
'

'
    Columns("A:A").Select
    Selection.Cut
    Columns("H:H").Select
    ActiveSheet.Paste
    Columns("B:B").Select
    Selection.Cut
    Columns("A:A").Select
    ActiveSheet.Paste
    Columns("H:H").Select
    Selection.Cut
    Columns("B:B").Select
    ActiveSheet.Paste
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Columns("G:G").Select
    Selection.Cut
    Columns("D:D").Select
    ActiveSheet.Paste
    Columns("H:H").Select
    Selection.Cut
    Columns("G:G").Select
    ActiveSheet.Paste
    Columns("D:D").Select
    Selection.NumberFormat = "0"
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
End Sub

Je voudrais donc que ma macro fasse ce traitement sur chacun des fichiers au format .xls et que celle-ci m'enregistre le résultat au format .csv pour que je puisse par la suite l'importer dans ma base de données.

En espérant que quelqu'un puisse m'aider
Cordialement

Djilow
 
C

Compte Supprimé 979

Guest
Re : Traitement sur x fichiers

Salut Djilow,

Voici un code
Code:
Option Explicit
 
Sub TraitementCarteLucent()
  Dim FSO  'As Scripting.FileSystemObject
  Dim SourceFolder  'As Scripting.Folder
  Dim SubFolder  'As Scripting.Folder
  Dim FileItem  'As Scripting.File
  Dim Vpath As String
  '
  Vpath = ChoisirDossier
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set SourceFolder = FSO.GetFolder(Vpath)
    ' Pour chaque fichier trouvé dans le dossier
    For Each FileItem In SourceFolder.Files
      Application.Workbooks.Open FileItem
      Columns("A:A").Cut 'Destination:=Columns("H:H")
      Columns("C:C").Insert Shift:=xlToRight
      'Columns("B:B").Cut Destination:=Columns("A:A")
      Columns("H:H").Cut Destination:=Columns("B:B")
      Columns("C:C").Insert Shift:=xlToRight
      Columns("G:G").Cut Destination:=Columns("D:D")
      Columns("H:H").Cut Destination:=Columns("G:G")
      Columns("D:D").NumberFormat = "0"
      Rows("1:1").Delete Shift:=xlUp
      ActiveWorkbook.Close
    Next FileItem
  ' Effacer les variables objet
  Set FileItem = Nothing
  Set SourceFolder = Nothing
  Set FSO = Nothing
End Sub
 
Private Function ChoisirDossier()
  Dim objShell, objFolder, chemin, SecuriteSlash
 
  Set objShell = CreateObject("Shell.Application")
  Set objFolder = _
  objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
  On Error Resume Next
  chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
  If objFolder.Title = "Bureau" Then
    chemin = "C:\Windows\Bureau"
  End If
  If objFolder.Title = "" Then
    chemin = ""
  End If
 
  SecuriteSlash = InStr(objFolder.Title, ":")
 
  If SecuriteSlash > 0 Then
    chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
  End If
  ' Renvoyer le chemin dans la fonction
  ChoisirDossier = chemin
End Function

ATTENTION toute fois à tes "cut" et "paste" qui me paraissent pour certains, illogiques

A+
 
Dernière modification par un modérateur:

tototiti2008

XLDnaute Barbatruc
Re : Traitement sur x fichiers

Bonjour Jenifer,

Tous les fichiers à traiter sont ouverts ?
si non, où sont-ils stockés, pour les ouvrir ?
chaque fichier n'a qu'une feuille de calcul ?
le format CSV d'export est avec séparateur ";" ou "," ?

Avec plus de précisions, tu aurais certainement déjà eu une réponse

Bing : Bonjour Bruno ;)
J'ai l'air de quoi, à raler maintenant :D
 

Djilow

XLDnaute Junior
Re : Traitement sur x fichiers

Bonjour
Tout d'abord merci à vous deux de prendre le temps de m'aider

Bruno je viens de tester ton code mais en fait il ne fait pas tout à fait ce que je voudrais :(

Je vais donc comme me le conseille toto essayer de donner des précisions
Tous les fichiers à traiter sont ouverts ?
si non, où sont-ils stockés, pour les ouvrir ?
chaque fichier n'a qu'une feuille de calcul ?
le format CSV d'export est avec séparateur ";" ou "," ?
Concernant les fichiers à traiter ils ne sont pas ouverts, en revanche ils sont tous au format Excel et sont tous dans le dossier où sera la macro
Il est donc simple d'en connaître le chemin, je pense que ce sera cela
Code:
Path = ThisWorkbook.Path & "\"
Chaque fichier ne dispose que d'une feuille de calcul.
Et concernant le format CSV d'export j'aimerais que les séparateurs soit des ";"
Petite précision en plus pour aider Bruno
En gros la macro ouvre le premier fichier .xls dans le répertoire courant
Dans ce fichier elle copie le contenu dans un nouveau fichier, en respectant l'ordre suivant:
Colonne 1 -> Circuit Pack
Colonne 2 -> Ne Name
Colonne 3 -> Colonne a laissé vide
Colonne 4 -> Com Code
Colonne 5 -> Actual Item Code
Colonne 6 -> Interchangeability Marker
Colonne 7 -> Serial Number
On supprime la première ligne contenant les noms de colonne
Puis on ferme le premier fichier .xls
On ouvre le fichier .xls suivant et on copie les données à la suite de celle déjà copié, on supprime la ligne avec les noms de colonne
Et ainsi de suite, pour au final enregistrer un fichier au format CSV contenant les données de tous les autres fichiers

Je mets pour exemple un fichier .xls si cela peut aiderRegarde la pièce jointe Data.xls

J'espère que mes explications sont assez explicites
Si besoin est n'hésitez pas à demander des précision
Merci d'avance :cool:
 

Pièces jointes

  • Data.xls
    38.5 KB · Affichages: 85
  • Data.xls
    38.5 KB · Affichages: 84

tototiti2008

XLDnaute Barbatruc
Re : Traitement sur x fichiers

Bonjour Djilow,

Donc il faut faire une recherche de tous les fichiers xls dans le répertoire où se trouvera ta macro ?
Quelle est ta version d'Excel ?

Edit : Pour la recherche on pourra se baser sur le code de Bruno
 
Dernière édition:

Djilow

XLDnaute Junior
Re : Traitement sur x fichiers

Bonjour tototiti
Je suis en version Excel 2003

Concernant la recherche de tout les fichiers je sais déjà le faire

Code:
Sub MiseEnForme()
Dim LePath As String
Dim Fich As String, X As String
Application.ScreenUpdating = False
LePath = ThisWorkbook.Path & "\"
Fich = Dir(LePath & "*.ri")
Do While Fich <> ""
    X = LePath & Fich
    Open X For Input As #1

    Close #1
    Fich = Dir
    Flag = False
Loop
End Sub

En revanche je n'arrive pas à faire le traitement sur les fichiers :(
Peut-être faudrait-il d'abord copier tout les fichiers dans une seule et même feuille et ensuite faire le traitement
 
Dernière édition:

tototiti2008

XLDnaute Barbatruc
Re : Traitement sur x fichiers

Re,

essaye voir ça et dis-nous ce que ça donne

(il manque juste l'enregistrement en CSV a priori)


Code:
Sub TraitementCarteLucent()
  Dim FSO  'As Scripting.FileSystemObject
  Dim SourceFolder  'As Scripting.Folder
  Dim SubFolder  'As Scripting.Folder
  Dim FileItem  'As Scripting.File
  Dim Vpath As String
  Dim DestWkb As Workbook, Ligne As Long
  
  Application.ScreenUpdating = False
  Ligne = 1
  Set DestWkb = Workbooks.Add
  Vpath = ThisWorkbook.Path
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set SourceFolder = FSO.GetFolder(Vpath)
    ' Pour chaque fichier trouvé dans le dossier
    For Each FileItem In SourceFolder.Files
      If UCase(FileItem) Like "*.XLS" Then
        Application.Workbooks.Open FileItem
        Columns("A:A").Cut 'Destination:=Columns("H:H")
        Columns("C:C").Insert Shift:=xlToRight
        'Columns("B:B").Cut Destination:=Columns("A:A")
        Columns("H:H").Cut Destination:=Columns("B:B")
        Columns("C:C").Insert Shift:=xlToRight
        Columns("G:G").Cut Destination:=Columns("D:D")
        Columns("H:H").Cut Destination:=Columns("G:G")
        Columns("D:D").NumberFormat = "0"
        Rows("1:1").Delete Shift:=xlUp
        ActiveWorkbook.ActiveSheet.UsedRange.Copy DestWkb.ActiveSheet.Range("A" & Ligne)
        Ligne = DestWkb.ActiveSheet.Range("A65536").End(xlUp).Row + 1
        ActiveWorkbook.Close False
      End If
    Next FileItem
  Application.ScreenUpdating = True
  ' Effacer les variables objet
  Set FileItem = Nothing
  Set SourceFolder = Nothing
  Set FSO = Nothing
End Sub
 

Djilow

XLDnaute Junior
Re : Traitement sur x fichiers

Tout d'abord merci tototiti
Par contre le traitement qui se fait n'est pas exactement celui que je veux
Que dois-je modifier pour arriver à
Colonne 1 -> Circuit Pack
Colonne 2 -> Ne Name
Colonne 3 -> Colonne a laissé vide
Colonne 4 -> Com Code
Colonne 5 -> Actual Item Code
Colonne 6 -> Interchangeability Marker
Colonne 7 -> Serial Number
 

tototiti2008

XLDnaute Barbatruc
Re : Traitement sur x fichiers

Re,

et comme ça ?

Code:
Sub TraitementCarteLucent()
  Dim FSO  'As Scripting.FileSystemObject
  Dim SourceFolder  'As Scripting.Folder
  Dim SubFolder  'As Scripting.Folder
  Dim FileItem  'As Scripting.File
  Dim Vpath As String
  Dim DestWkb As Workbook, Ligne As Long
  
  Application.ScreenUpdating = False
  Ligne = 1
  Set DestWkb = Workbooks.Add
  Vpath = ThisWorkbook.Path
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set SourceFolder = FSO.GetFolder(Vpath)
    ' Pour chaque fichier trouvé dans le dossier
    For Each FileItem In SourceFolder.Files
      If UCase(FileItem) Like "*.XLS" Then
        Application.Workbooks.Open FileItem
    Columns("B:B").Cut
    Columns("A:A").Insert Shift:=xlToRight
    Columns("F:F").Cut
    Columns("C:C").Insert Shift:=xlToRight
    Columns("D:D").Delete Shift:=xlToLeft
    Columns("G:G").Delete Shift:=xlToLeft
    Columns("C:C").Insert Shift:=xlToRight
        Rows("1:1").Delete Shift:=xlUp
        ActiveWorkbook.ActiveSheet.UsedRange.Copy DestWkb.ActiveSheet.Range("A" & Ligne)
        Ligne = DestWkb.ActiveSheet.Range("A65536").End(xlUp).Row + 1
        ActiveWorkbook.Close False
      End If
    Next FileItem
  Application.ScreenUpdating = True
  ' Effacer les variables objet
  Set FileItem = Nothing
  Set SourceFolder = Nothing
  Set FSO = Nothing
End Sub
 

Djilow

XLDnaute Junior
Re : Traitement sur x fichiers

Merci tototiti
En essayant de comprendre la logique j'ai réussi à traiter les fichiers comme je voulais
Je mets le code car il reste deux petits hic
Code:
Sub TraitementCarteLucent()
  Dim FSO  'As Scripting.FileSystemObject
  Dim SourceFolder  'As Scripting.Folder
  Dim SubFolder  'As Scripting.Folder
  Dim FileItem  'As Scripting.File
  Dim Vpath As String
  Dim DestWkb As Workbook, Ligne As Long
  Application.ScreenUpdating = False
  Ligne = 1
  Set DestWkb = Workbooks.Add
  Vpath = ThisWorkbook.Path
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set SourceFolder = FSO.GetFolder(Vpath)
    ' Pour chaque fichier trouvé dans le dossier
    For Each FileItem In SourceFolder.Files
      If UCase(FileItem) Like "*.XLS" Then
        Application.Workbooks.Open FileItem
        Columns("B:B").Cut Destination:=Columns("H:H")
        Columns("A:A").Cut Destination:=Columns("B:B")
        Columns("H:H").Cut Destination:=Columns("A:A")
        Columns("C:C").Insert Shift:=xlToRight
        Columns("G:G").Cut Destination:=Columns("D:D")
        Columns("H:H").Cut Destination:=Columns("G:G")
        Columns("D:D").NumberFormat = "0"
        Rows("1:1").Delete Shift:=xlUp
        ActiveWorkbook.ActiveSheet.UsedRange.Copy DestWkb.ActiveSheet.Range("A" & Ligne)
        Ligne = DestWkb.ActiveSheet.Range("A65536").End(xlUp).Row + 1
        ActiveWorkbook.Close False
      End If
    Next FileItem
  Application.ScreenUpdating = True
  ' Effacer les variables objet
  Set FileItem = Nothing
  Set SourceFolder = Nothing
  Set FSO = Nothing
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs Filename:=Vpath & "\" & "carte.csv", FileFormat:=xlCSV
  ActiveWorkbook.Close
End Sub
1er petit beug: Columns("D:D").NumberFormat = "0" ne fonctionne pas correctement, je m'explique, j'obtiens un nombre au format 108244104 006 alors qu'il devrait être sous la forme 108244104006
2eme petit beug: Mon fichier est bien enregistré dans mon répertoire au format csv mais quand je l'ouvre les séparateurs sont des virgules et du coup toutes les données sont condensés dans une seul et même colonne

Saurais-tu de quoi cela vient ?

merci d'avance
 

tototiti2008

XLDnaute Barbatruc
Re : Traitement sur x fichiers

Re,

un nombre au format 108244104 006

c'est sans doute qu'il ne le considère pas comme un nombre
Il faut certainement remplacer les espaces par rien dans la colonne

2eme petit beug: Mon fichier est bien enregistré dans mon répertoire au format csv mais quand je l'ouvre les séparateurs sont des virgules et du coup toutes les données sont condensés dans une seul et même colonne

essaye comme ça :

Code:
ActiveWorkbook.SaveAs Filename:=Vpath & "\" & "carte.csv", FileFormat:=xlCSVWindows, Local:=True
 

Djilow

XLDnaute Junior
Re : Traitement sur x fichiers

Merci tototiti
Du coup j'avais trouvé le Local:=True dans un post du forum
Et concernant le format du nombre ce n'est pas très important je le laisse finalement sous la forme 108 244 104 006
Encore merci pour le temps passé à résoudre mon problème
Chapeau l'artiste :cool:
 

Discussions similaires

Réponses
2
Affichages
883

Statistiques des forums

Discussions
311 720
Messages
2 081 926
Membres
101 841
dernier inscrit
ferid87