XL 2019 Création d'une boucle pour importer des fichiers d'un répertoire

[Xavier_09]

Bonjour à tous,

Je suis un nouveau membre et novice concernant le langage VBA.

Voici mon problème :

Je souhaite importer des fichiers issue d'un répertoire sur un fichier Excel. Pour chaque fichier présent dans le répertoire, je dois ouvrir une nouvelle feuille Excel dans le même fichier Excel et répéter cette action autant de fois que de fichiers présents dans mon répertoire.

Pour chaque fichier importé, une nouvelle feuille s'ouvre avec une mise en page identique pour toutes les feuilles. De plus, le nom de la feuille prend celui du fichier importé.

J'ai essayé de nombreux codes mais étant débutant, je coince!

Quelqu'un aurait-il une solution ?

 

[vgendron]

Bonjour

Qu'as tu réussi à faire déjà?

 

[vgendron]

un exemple qui permet de boucler sur tous les xls du répertoire actif, et d'importer la feuile1

attention: si pas de feuil1==> ca plante

faudra voir en fonction de ton besoin, de tes fichiers, de ce que tu souhaites importer.......

Sub BoucleFichiers()
    Dim WbDest As Workbook
    Dim WbSource As Workbook
    Dim Chemin As String, Fichier As String
    
    Set WbDest = ActiveWorkbook
 
    'Définit le répertoire contenant les fichiers
    Chemin = ActiveWorkbook.Path & "\"
 
    'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(Chemin & "*.xls")
    'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers :
    'Fichier = Dir(Chemin & "*.*")
 
    Do While Len(Fichier) > 0
        
        Application.Workbooks.Open Fichier 'on ouvre le fichier
        Set WbSource = ActiveWorkbook 'on fait un set
        WbSource.Sheets("Feuil1").Copy After:=WbDest.Sheets(WbDest.Sheets.Count) 'on copie la feuille "Feuil1" du fichier Source vers le fichier destination
        WbDest.Sheets(WbDest.Sheets.Count).Name = WbSource.Name 'on renomme la feuille importée avec le nom du classeur source
    
        Application.Workbooks(Fichier).Close 'on ferme le classeur source
        Fichier = Dir() 'on passe au suivant
    Loop
End Sub

 

[Xavier_09]

Bonjour,

Pour l'instant, avec de l'aide, j'ai réussi à importer mes fichiers (images) dans une même feuille mais, pour que le codage soit optimal, il faudrait que chaque feuille contienne juste une image (issue de mon répertoire source) avec, comme nom de feuille, celui du fichier importé. Je souhaite arriver à ce résultat car je dois suivre les modifications de paramètres en temps réel sur mon parc machine.

Voici le code actuel :

Sub Boucle_Des_Images()
     Application.ScreenUpdating = False
     t = Timer
     mypath = "P:\Documentations techniques\Combibloc\ACB\Paramètres_HMI\"     'votre repertoire
     'mypath = Environ("USERPROFILE") & "\Downloads\"     'mon repertoire pour tester

     For Each ext In Array("png", "jpg", "bmp", "jpeg", "img")    'toute sorte des images
          Set sh = Sheets(CStr(ext))     'une feuille
          With sh
               .Activate
               With .Cells
                    .ColumnWidth = 40     'adjuste width & height of colonnes et lignes
                    .RowHeight = 200
               End With

               ptr = 0     'pointer
               myfile = Dir(mypath & "*." & ext)     'filtrer les files du type EXT
               Do While myfile <> ""     'boucle jusqu'aux tous files sont traités
                    s = mypath & myfile 'fullname
                    If ptr Mod 10 = 0 Then Application.StatusBar = sh.Name & "    " & ptr: DoEvents: DoEvents 'montrer progrès sur statusbar
                    ptr = ptr + 1 'augmente pointer
                    ligne = (ptr - 1) \ 10 + 1 'ligne pour l'image
                    col = (ptr - 1) Mod 10 + 1 'colonne pour l'image
                    Set c = .Cells(ligne, col) 'mettez l'image dans cette cellule
                    lft = c.Left + 2 'gauche de l'image
                    tp = c.Top + 2 'top de l'image
                    wdth = c.Offset(, 1).Left - c.Left - 5 'largeur de l'image
                    hgth = c.Offset(1).Top - c.Top - 5 'hauteur de l'image
                    .Shapes.AddPicture s, 1, 1, lft, tp, wdth, hgth 'add image
                    DoEvents: DoEvents 'ralentir le système
                    myfile = Dir 'prochaine file
               Loop
          End With
     Next
    
     Application.ScreenUpdating = True
     Application.StatusBar = ""
    
     MsgBox "prêt : " & Format(Timer - t, "0.00\s")
End Sub

 

[vgendron]

Hello

un début de réponse que je te laisse adapter à ton besoin
Cette solution vérifie que la feuille n'existe pas déjà
la créé le cas échéant

Sub Boucle_Des_Images()
     Application.ScreenUpdating = False
     t = Timer
     'mypath = "P:\Documentations techniques\Combibloc\ACB\Paramètres_HMI\"     'votre repertoire
     mypath = Environ("USERPROFILE") & "\Downloads\"     'mon repertoire pour tester

     For Each ext In Array("png", "jpg", "bmp", "jpeg", "img")    'toute sorte des images
          If Not FeuilleExiste(CStr(ext)) Then
            Sheets.Add
            ActiveSheet.Name = CStr(ext)
          End If
          Set sh = Sheets(CStr(ext))     'une feuille
          With sh
               .Activate
               With .Cells
                    .ColumnWidth = 40     'adjuste width & height of colonnes et lignes
                    .RowHeight = 200
               End With

               ptr = 0     'pointer
               myfile = Dir(mypath & "*." & ext)     'filtrer les files du type EXT
               Do While myfile <> ""     'boucle jusqu'aux tous files sont traités
                    s = mypath & myfile 'fullname
                    If ptr Mod 10 = 0 Then Application.StatusBar = sh.Name & "    " & ptr: DoEvents: DoEvents 'montrer progrès sur statusbar
                    ptr = ptr + 1 'augmente pointer
                    ligne = (ptr - 1) \ 10 + 1 'ligne pour l'image
                    col = (ptr - 1) Mod 10 + 1 'colonne pour l'image
                    Set c = .Cells(ligne, col) 'mettez l'image dans cette cellule
                    lft = c.Left + 2 'gauche de l'image
                    tp = c.Top + 2 'top de l'image
                    wdth = c.Offset(, 1).Left - c.Left - 5 'largeur de l'image
                    hgth = c.Offset(1).Top - c.Top - 5 'hauteur de l'image
                    .Shapes.AddPicture s, 1, 1, lft, tp, wdth, hgth 'add image
                    DoEvents: DoEvents 'ralentir le système
                    myfile = Dir 'prochaine file
               Loop
          End With
     Next
    
     Application.ScreenUpdating = True
     Application.StatusBar = ""
    
     MsgBox "prêt : " & Format(Timer - t, "0.00\s")
End Sub


Function FeuilleExiste(NomFeuille As String) As Boolean

FeuilleExiste = False
For Each ws In ActiveWorkbook.Sheets
    If ws.Name = NomFeuille Then
        FeuilleExiste = True
        Exit Function
    End If
Next ws
End Function

 

[Xavier_09]

Bonjour,

Voici ce que je cherche à faire :

Sub Importimagesversfeuilles()
sh = Sheet
rg = Range
mypath = "P:\Documentations_techniques\aaa\bbb\ccc"
f = fichier lambda inclut dans le répertoire

For Each f In mypath
'J'ouvre une nouvelle feuille
'Je vérifie que le fichier je j'importe est bien au format image ("png", "jpg", "bmp", "jpeg", "img") dans le répertoire source
‘Si oui je place l'image en "Range(B2)" dans la feuille que je viens d'ouvrir
'J'intègre ma mise en page en enregistrant une macro
´Je nomme la feuille par "ccc"
´Renouveler ce travail jusqu'au dernier fichier du répertoire
Next
End Sub

Je n’ai pas encore de trouvé de solution fonctionnelle…

Quelqu’un pourrait l’aiguiller ?

 

[vgendron]

Hello
qu'est ce qui ne va pas dans la solution du post #5 ?
j'ai essayé chez moi:
ca importe bien toutes les images du répertoire spécifié (et uniquement les images dont les types sont spécifiés) ==> pas besoin de vérifier que l'image est bien au format

les images de meme type sont bien regroupées dans les feuilles (feuille jpg pour les imags jpg, feuille bmp pour les images bmp...)

après.. si tu veux une feuille par image==> attention: le nombre d'onglet est limité.. et est ce vraiment necessaire? si oui. c'est quoi l'objectif derrière?