Pb code pour Copie de fichiers cvs dans onglets d'excel

Question

Bonjour, 

Je suis en train de coder un programme vba, et étant à mes débuts j'ai certains bug que je ne comprends pas. 

L'objectif de mon programme : Je veux exporter et formater des données cvs dans différents onglets d'un fichier excel. Pour cela je dois :
-  demander à l'utilisateur de choisir à partir de quel répertoire il veut faire ça [ok]
- Aller chercher les fichiers cvs [ok]
- Les ouvrir et les copier dans des onglets différents [BUG]
- formater les données d'une certaine façon [pas encore implémenté]
- avoir le titre de mon fichier cvs dans en tant que nom de chaque onglet [pas encore implémenté]

J'ai parcouru le forum et le net à la recherche d'aide et j'en suis venu à copier des formules par ci par là. Je dois du coup sans doute être en train de manipuler des forces que je ne contrôle pas ....
Mon programme fonctionne mais ne copie pas les données du fichier du tout et j'aimerais comprendre pourquoi

Merci d'avance de votre aide !! (Etant donné que j'ai copié plusieurs codes différents il doit y avoir des parties superflues aussi, si oui je veux bien savoir lesquelles)

Voici mon code

Sub demo()
    'creation de la liste des fichiers contenu dans le repertoire qui contient ce même fichier
    Dim MyWay As String, FichierXl As String, CompteurDeFichier As Integer
    Dim MessageFinDeTraitement As String, MaFeuille As Worksheet
    Dim Repertoire As FileDialog
    
    'Déclaration des variables pour l'importation du cvs
    Dim appExcel As Excel.Application 'Application Excel
    Dim wbExcel As Excel.Workbook 'Classeur Excel
    Dim wsExcel As Excel.Worksheet 'Feuille Excel
    
    'Selection d'un repertoire

Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    If Repertoire.SelectedItems.Count > 0 Then
    MyWay = Repertoire.SelectedItems(1) 'chemin du fichier dans variable my way
    Else
    MsgBox "Aucun Répertoire Sélectionné"
    End If
  
    CompteurDeFichier = 0 'initialisation du compteur
    FichierXl = Dir(MyWay & "\*.csv") 'on commence la récupération des fichiers .xls
    Do While Not FichierXl = "" 'on boucle tant que la variable FichierXl n'est pas vide
        CompteurDeFichier = CompteurDeFichier + 1 'incrémentation du compteur
        If CompteurDeFichier = 1 Then ' au premier fichier trouvé
            On Error Resume Next 'en cas d'erreur sur la prochaine ligne
                Set MaFeuille = Worksheets.Add(after:=Worksheets(Worksheets.Count)) ' on ajoute un nouvel onglet
                'on lui donne son nom
                MaFeuille.Name = "Test" & CompteurDeFichier
                ' On ouvre le fichier cvs trouvé par le compteur et on initialise le séparareur comme étant la virgule
                Workbooks.OpenText Filename:="MyWay", Origin:=xlWindows, _
                StartRow:=2, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
     'on copie les données dans un onglet
                'Ouverture de l'application
                Set appExcel = CreateObject("Excel.Application")
                'Ouverture d'un fichier Excel
                Workbooks.OpenText Filename:="Myway", Origin:=xlWindows, _
                StartRow:=2, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
                Set wbExcel = appExcel.ActiveWorkbook
                Set wsExcel = wbExcel.ActiveSheet
                wsExcel.UsedRange.Copy Destination:=MaFeuille.Range("A" & Rows.Count).End(xlUp).Offset(0)
                wbExcel.Close
           On Error GoTo 0 'annule le precedent on error
           
        End If
        'on écrit dans la liste le nom du fichier trouvé
          FichierXl = Dir 'on passe au fichier suivant
        DoEvents 'en cas de problème on pourra toujours sortir de la boucle avec la touche [échap]
    Loop
    If CompteurDeFichier = 0 Then ' si pas de fichier
        MessageFinDeTraitement = "Aucun Fichier trouvé dans le répertoire spécifié ! "
    Else 'si un fichier ou plus a/on été trouvé(s)
        MessageFinDeTraitement = CompteurDeFichier & " fichier(s) trouvé(s) "
    End If
    ' on affiche un message en fin de traitement
    MsgBox MessageFinDeTraitement
End Sub


     EDIT : Ajout du LANGAGE dans les balises de code (la coloration syntaxique).
Explications disponibles ici : ICI 

Merci d'y penser dans tes prochains messages.

f894009 · Answer

Bonjour,

un exemple en partant d'une partie de votre code (choix du repertoire):

https://www.cjoint.com/c/EJekhfBRetf

Naknak · Answer

Bonjour  f894009

J'ai essayé votre code ce week end mais n'arrivais pas à le faire fonctionner sur mon ordi. Jusqu'à ce matin pour une raison que j'ignore.. (du coup je re-regarderai ça)

En parallèle j'ai modifié mon code d'origine en essayant de m'inspirer de votre façon de faire. A part une ligne, j'ai presque réussi à faire ce que je voulais, il faudra juste que j'implémente le formatage que je veux sur mon fichier (formatage que j'ai préalablement enregistrer avec la fonction "enregistrer" de vba). Mon programme ne semble pas comprendre ce qu'est Fichier Xl dans  Workbooks.OpenText Filename:="FichierXl",

Alors que FichierXl a bien été défini dans la fonction précédente. Je ne comprends pas pourquoi il ne l'accepte pas. Que dois-je faire pour corriger ça ? Pourquoi il ne le prend pas ?

Merci de votre aide !


Mon code

Sub demo()
    'creation de la liste des fichiers contenu dans le repertoire qui contient ce même fichier
    Dim MyWay As String, FichierXl As String, CompteurDeFichier As Integer
    Dim MessageFinDeTraitement As String, MaFeuille As Worksheet
    Dim Repertoire As FileDialog

'Selection d'un repertoire

Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    If Repertoire.SelectedItems.Count > 0 Then
    MyWay = Repertoire.SelectedItems(1) 'chemin du dossier dans variable my way
    Else
    MsgBox "Aucun Répertoire Sélectionné"
    End If
  
    CompteurDeFichier = 0 'initialisation du compteur
    FichierXl = Dir(MyWay & "\*.csv") 'on commence la récupération des fichiers .xls
    Do While Not FichierXl = "" 'on boucle tant que la variable FichierXl n'est pas vide
       CompteurDeFichier = CompteurDeFichier + 1 'incrémentation du compteur
        If CompteurDeFichier = 1 Then ' au premier fichier trouvé
            On Error Resume Next 'en cas d'erreur sur la prochaine ligne
                Set MaFeuille = Worksheets.Add(after:=Worksheets(Worksheets.Count)) ' on ajoute un nouvel onglet
                'on lui donne son nom
                MaFeuille.Name = "Test" & CompteurDeFichier
                ' On ouvre le fichier cvs trouvé par le compteur et on initialise le séparareur comme étant la virgule
                 On Error GoTo 0 'annule le precedent on error
                            
        End If
          FichierXl = Dir 'on passe au fichier suivant
        DoEvents 'en cas de problème on pourra toujours sortir de la boucle avec la touche [échap]
    Loop
    If CompteurDeFichier = 0 Then ' si pas de fichier
        MessageFinDeTraitement = "Aucun Fichier trouvé dans le répertoire spécifié ! "
    Else 'si un fichier ou plus a/on été trouvé(s)
        MessageFinDeTraitement = CompteurDeFichier & " fichier(s) trouvé(s) "
    End If
    ' on affiche un message en fin de traitement
    MsgBox MessageFinDeTraitement
End Sub

Sub ConversionCVS(FichierXl)
    
    'Déclaration des variables pour l'importation du cvs
    Dim appExcel As Excel.Application 'Application Excel
    Dim wbExcel As Excel.Workbook 'Classeur Excel
    Dim wsExcel As Excel.Worksheet 'Feuille Excel

'Ouverture de l'application
      Set appExcel = CreateObject("Excel.Application")
     'Ouverture d'un fichier Excel
      Workbooks.OpenText Filename:="FichierXl", Origin:=xlWindows, _
      StartRow:=2, DataType:=xlsDelimited, TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

Set wbExcel = appExcel.ActiveWorkbook
     Set wsExcel = wbExcel.ActiveSheet
     wsExcel.UsedRange.Copy Destination:=MaFeuille.Range("A" & Rows.Count).End(xlUp).Offset(0)
     wbExcel.Close
                          
End Sub

f894009 · Answer

Re,

En regardant votre code  (Naknak 5 oct. 2015 à 09:59) de plus pres, FichierXl ne contient que le nom du fichier avec extention pas le chemin complet, c'est peut-etre la que ca coince.....

Naknak · Answer

Bonjour f894009,

Après des semaines de travail acharnées, il semble que la ligne de commande que j'utilisais pour faire le copy/Paste n'était pas approprié. Le programme avait du mal à identifier d'où il partait et où il arrivait.

Avec de l'aide extérieur je suis parti sur une approche plus simple du type : "on active la workseek"
 "on sélectionne la feuille à copier ou la gamme"
 "on copie la selection", "on active la workseet de destination"
 "on sélectionne la gamme d'arrivée"
"on colle la selection"

Cette approche a très bien fonctionné, et j'ai donc pu faire mon copier/coller et ajouter la mise en forme que je voulais pour ma feuille.

Merci de m'avoir aidé à débeuguer les premières étapes.

Pour les personnes qui auraient eues le même problème que moi, voici la version finale de mon code :

Sub demo()
    'creation de la liste des fichiers contenu dans le repertoire qui contient ce même fichier
    Dim MyWay As String, FichierXl As String, CompteurDeFichier As Integer
    Dim MessageFinDeTraitement As String, MaFeuille As Worksheet
    Dim Repertoire As FileDialog, monchemin As String
  
    'Selection d'un repertoire
   
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    If Repertoire.SelectedItems.Count > 0 Then
    MyWay = Repertoire.SelectedItems(1) 'chemin du dossier dans variable my way
    Else
    MsgBox "Aucun Répertoire Sélectionné"
    End If

CompteurDeFichier = 0 'initialisation du compteur
    FichierXl = Dir(MyWay & "\*.csv") 'on commence la récupération des fichiers .xls
    Do While Not FichierXl = "" 'on boucle tant que la variable FichierXl n'est pas vide
       CompteurDeFichier = CompteurDeFichier + 1 'incrémentation du compteur
              
        If CompteurDeFichier <> 0 Then ' au premier fichier trouvé
            On Error Resume Next 'en cas d'erreur sur la prochaine ligne
                 monchemin = MyWay & "\" & FichierXl
                Set MaFeuille = Worksheets.Add(After:=Worksheets(Worksheets.Count)) ' on ajoute un nouvel onglet
                'on lui donne son nom
                 MaFeuille.Name = FichierXl
                ' On ouvre le fichier cvs trouvé par le compteur et on initialise le séparareur comme étant la virgule
                 On Error GoTo 0 'annule le precedent on error
                 Call ConversionCVS(monchemin)
                 
            'ActiveSheet.Range("A2:G511").Select ' Si tu préfère sélectionner des cellules spécifiques
             ActiveSheet.Cells.Select 'Sélectionne toute les cellules de la feuille
             Selection.Copy ' Copy toute les cellules
             Windows("Classeur1.xlsm").Activate ' On se place dans l'autre classeur
             MaFeuille.Select
             ActiveSheet.Paste
             Application.CutCopyMode = False
             Windows(FichierXl).Activate
             ActiveWorkbook.Close False

End If
          FichierXl = Dir 'on passe au fichier suivant
        DoEvents 'en cas de problème on pourra toujours sortir de la boucle avec la touche [échap]
    Loop
    If CompteurDeFichier = 0 Then ' si pas de fichier
        MessageFinDeTraitement = "Aucun Fichier trouvé dans le répertoire spécifié ! "
    Else 'si un fichier ou plus a/on été trouvé(s)
        MessageFinDeTraitement = CompteurDeFichier & " fichier(s) trouvé(s) "
    End If
    ' on affiche un message en fin de traitement
    MsgBox MessageFinDeTraitement
End Sub

Sub ConversionCVS(monchemin)

'Ouverture d'un fichier Excel
      Workbooks.OpenText Filename:=monchemin, Origin:=xlWindows, _
      StartRow:=2, DataType:=xlDelimited, TextQualifier:=xlNone, _
      ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
      
      ' MISE EN FORME DES DONNEES
      ' Suppression des données inutiles
      Rows("1:219").Select
      Selection.Delete Shift:=xlUp
      Columns("C:E").Select
      Selection.Delete Shift:=xlToLeft
      
      ' Données des différents Vd mises côte à côtes
      Range("C99:D195").Select
      Selection.Cut
      Range("E2:F98").Select
      ActiveSheet.Paste
      Range("C196:D292").Select
      Selection.Cut
     Range("G2:H98").Select
      ActiveSheet.Paste
            
     ' Supression des données superflues
      Range("A99:B292").Select
      Selection.Delete Shift:=xlUp
     
     ' On mets les titres sur chaque colonnes
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Id - Vd -0,1"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Ig - Vd -0,1"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Id- Vd -0,5"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Ig-Vd-0,5"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Id -Vd-0,9"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Ig -Vd-0,9+"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Ig -Vd-0,9"

' Supression des données superflues
      Columns("A").Select
      Selection.Delete Shift:=xlUp

End Sub

Pb code pour Copie de fichiers cvs dans onglets d'excel

4 réponses

Newsletters