none
Parcourir des fichiers excel RRS feed

  • Question

  • Bonsoir ; 

    Svp j'ai besoin de votre aide je veux parcourir plusieurs fichiers excel sachant que chque fichiers a une sheet qui s'appele statusrepport et je veux copier de chaque fichiers à partir de ligne jusqu'a la derniére ligne et je vais les coller sur un fichier excel TL à partir de ligne D27 c'est un peu compliqué mais j'ai confiance en vous j'ai essayé ce code mais il traite un seul fi chier et merci d'avance 

    Imports Microsoft.Office.Interop.Excel
    Imports Microsoft.Office.Interop
    
    Public Class Form1
    
        Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
            Dim Système As Object           'Système de fichiers  
            Dim Dossier As Object           'Répertoire  
            Dim Fichiers As Object          'Collection de fichiers du répertoire  
            Dim Fichier As Object           'Fichier (élément de la collection Fichiers)  
            Dim Nom_Dossier As String       'Nom du répertoire  
            Dim Nom_Fichier As String       'Nom du fichier  
            Dim xlWorkBook, xlWorkBook2 As Excel.Workbook
            Dim xlWsheet2 As Excel.Worksheet
            Dim xlApp As New Excel.Application
            xlApp.Visible = True
            'Lecture du répertoire 
            Nom_Dossier = "C:\Users\sarra.arfaoui\Desktop\test 1"
            Système = CreateObject("Scripting.FileSystemObject")
            Dossier = Système.GetFolder(Nom_Dossier)
            Fichiers = Dossier.Files
            xlWorkBook2 = xlApp.Workbooks.Open("C:\Users\sarra.arfaoui\Desktop\test 1\ss\Template TL Status Report V2.0.xlsx")
            xlWsheet2 = xlWorkBook2.Sheets("Status Report")
           
            'Contrôler chaque fichier du répertoire 
            For Each Fichier In Fichiers
                '- Vérifier s'il s'agit d'un fichier Excel... 
    
                '... dans l'affirmative, ouvrir le fichier et mettre à jour les liaisons 
                Nom_Fichier = Nom_Dossier & "\" & Fichier.Name
                xlWorkBook = xlApp.Workbooks.Open(Filename:=Nom_Fichier, UpdateLinks:=XlUpdateLinks.xlUpdateLinksAlways)
    
    
              
                Dim DernLigne As Long
                DernLigne = xlWorkBook.Sheets("StatusReport").Range("D" & xlWorkBook.Sheets("StatusReport").Rows.Count).End(XlDirection.xlUp).Row
    
    
                xlWorkBook.Sheets("StatusReport").Range("D25:K" & DernLigne).Copy( _
                Destination:=xlWsheet2.Range("D27"))
                Dim DernLigne3 As Long
                DernLigne3 = xlWsheet2.Range("D" & xlWsheet2.Rows.Count).End(XlDirection.xlUp).Row
                While (xlWsheet2.Range("D" & (DernLigne3)).Text <> "")
                    xlWorkBook.Sheets("StatusReport").Range("D25:K" & DernLigne).Copy( _
                    Destination:=xlWsheet2.Range("D" & (DernLigne3)))
    
                End While
    
    
                xlWorkBook2.SaveAs(Filename:="C:\Users\sarra.arfaoui\Desktop\test 1\ss\TL.xlsx")
                xlWorkBook.Close()
                xlWorkBook2.Close()
            Next Fichier
    
            xlApp.Quit()
        End Sub
    End Class
    

    Cordialement; 

    mercredi 25 septembre 2013 14:11

Réponses

Toutes les réponses

  • Bonjour sarraarfaoui

    Si je comprends bien vous copiez toujours dans le même endroit avec :
         xlWorkBook.Sheets("StatusReport").Range("D25:K" & DernLigne).Copy( _
                Destination:=xlWsheet2.Range("D27"))
    Donc chaque ficher sur écrit les autres.

    En plus je ne vois plus la logique d'avoir le WHILE

    Je dirais d’utiliser simplement :

    DernLigne3 = xlWsheet2.Range("D" & xlWsheet2.Rows.Count).End(XlDirection.xlUp).Row
         xlWorkBook.Sheets("StatusReport").Range("D25:K" & DernLigne).Copy( _
                Destination:=xlWsheet2.Range("D" & DernLigne3))

    Cordialement,


    Aurel BERA, MSFT
    MSDN Community Support. LE CONTENU EST FOURNI "TEL QUEL" SANS GARANTIE D'AUCUNE SORTE, EXPLICITE OU IMPLICITE.
    S'il vous plaît n'oubliez pas de "Marquer comme réponse" les réponses qui ont résolu votre problème. C'est une voie commune pour reconnaître ceux qui vous ont aidé, et rend plus facile pour les autres visiteurs de trouver plus tard la résolution.

    jeudi 26 septembre 2013 07:32
  • Bonjour 

    Pour Corriger j'ai essayé ce code 

    Public Class Form1
    
        Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
            Dim Système As Object           'Système de fichiers  
            Dim Dossier As Object           'Répertoire  
            Dim Fichiers As Object          'Collection de fichiers du répertoire  
            Dim Fichier As Object           'Fichier (élément de la collection Fichiers)  
            Dim Nom_Dossier As String       'Nom du répertoire  
            Dim Nom_Fichier As String       'Nom du fichier  
            Dim xlWorkBook, xlWorkBook2 As Excel.Workbook
            Dim xlWsheet2 As Excel.Worksheet
            Dim xlApp As New Excel.Application
            xlApp.Visible = True
            'Lecture du répertoire 
            Nom_Dossier = "C:\Users\sarra.arfaoui\Desktop\test 1"
            Système = CreateObject("Scripting.FileSystemObject")
            Dossier = Système.GetFolder(Nom_Dossier)
            Fichiers = Dossier.Files
    
            xlWorkBook2 = xlApp.Workbooks.Open("C:\Users\sarra.arfaoui\Desktop\test 1\Sarra\Template TL Status Report V2.0.xlsx")
            xlWsheet2 = xlWorkBook2.Sheets("Status Report")
            For Each Fichier In Fichiers
          
                Nom_Fichier = Nom_Dossier & "\" & Fichier.Name
                xlWorkBook = xlApp.Workbooks.Open(Filename:=Nom_Fichier, UpdateLinks:=XlUpdateLinks.xlUpdateLinksAlways)
    
                Dim DernLigne As Long
                DernLigne = xlWorkBook.Sheets("StatusReport").Range("D" & xlWorkBook.Sheets("StatusReport").Rows.Count).End(XlDirection.xlUp).Row
    
    
                Dim DernLigne3 As Long
                DernLigne3 = xlWsheet2.Range("Q" & xlWsheet2.Rows.Count).End(XlDirection.xlUp).Row
    
    
                xlWorkBook.Sheets("StatusReport").Range("D25:K" & DernLigne).Copy( _
                       Destination:=xlWsheet2.Range("D" & DernLigne3 + 1))
            Next Fichier
            xlApp.Quit()
        End Sub
    End Class

    mais je pense qu'il est entrain de copier à partir de le meme range or que je cherche qui seront copiés l'un dernier l'autre 

    Merci pour votre précieuse aide 

    vendredi 27 septembre 2013 10:31
  • Bonjour

    Il copie à partir de DernLigne3  qui normalement c'est à la fin du Sheet. Utilisez le debugger pour voir les valeurs
    de DernLigne3.

    Cordialement,


    Aurel BERA, MSFT
    MSDN Community Support. LE CONTENU EST FOURNI "TEL QUEL" SANS GARANTIE D'AUCUNE SORTE, EXPLICITE OU IMPLICITE.
    S'il vous plaît n'oubliez pas de "Marquer comme réponse" les réponses qui ont résolu votre problème. C'est une voie commune pour reconnaître ceux qui vous ont aidé, et rend plus facile pour les autres visiteurs de trouver plus tard la résolution.

    • Marqué comme réponse sarraarfaoui lundi 30 septembre 2013 11:05
    vendredi 27 septembre 2013 12:03
  • Bonjour

    Avez-vous des nouvelles pour nous?

    Merci!

    Cordialement,


    Aurel BERA, MSFT
    MSDN Community Support. LE CONTENU EST FOURNI "TEL QUEL" SANS GARANTIE D'AUCUNE SORTE, EXPLICITE OU IMPLICITE.
    S'il vous plaît n'oubliez pas de "Marquer comme réponse" les réponses qui ont résolu votre problème. C'est une voie commune pour reconnaître ceux qui vous ont aidé, et rend plus facile pour les autres visiteurs de trouver plus tard la résolution.

    • Marqué comme réponse sarraarfaoui lundi 30 septembre 2013 11:06
    lundi 30 septembre 2013 09:52
  • J'ai utiliser cut je les deplacer vers la position souhaitée
      Dim DernLigne4 As Long
            DernLigne4 = xlWsheet2.Range("K" & xlWsheet2.Rows.Count).End(XlDirection.xlUp).Row
           
            xlWsheet2.Range("D" & DernLigne5 + 1 & ":L" & DernLigne4).Cut(xlWsheet2.Range("D27"))

    lundi 30 septembre 2013 11:08