Cela répondra à votre requête, il est plus d'une solution qu'une réponse qui n'est pas ce que ce site est pour, mais prendre le temps de lire comme il devrait être pédagogiquement trop utile.
Vous essayez d'analyser un dossier qui a un contenu similaire à ci-dessous: -
L'os de résultat pour ces être dans un classeur Excel, avec une feuille de calcul contenant le texte et l'image pour chaque groupe (AA, BB et CC)
La première étape que je prendrais est d'utiliser Microsoft Scripting Runtime, ce qui rend l'analyse du dossier beaucoup plus facile. Pour activer cela, dans l'environnement VBA (appelé IDE), sélectionnez 'Outils'> 'Références ...', faites défiler jusqu'à 'Microsoft Scripting Runtime' et cochez-le, puis cliquez sur 'OK' pour fermer la boîte de dialogue.
Cela nous permet de l'objet du système de fichiers, ce qui est une très manipulation de fichiers utiles et le dossier et fonction d'interrogation ensemble.
Tout d'abord nous intéressent le plus les fichiers * .txt permet donc de commencer par une boucle à travers eux: -
Dim FSO As New FileSystemObject
Dim Fldr As Folder
Dim Fl As File
'First we set Fldr to be the folder we care about
Set Fldr = FSO.GetFolder("C:\Users\garye\Desktop\Work")
'Then start a loop to look through each file in the folder
For Each Fl In Fldr.Files
'If the files ends in .txt then we care about it (UCASE used to make it case insensitive)
If Right(UCase(Fl.Name), 4) = ".TXT" Then
'We have found a file
End If
'Do events returns the processor to the system for any other items to be process
'very useful in a loop on a Windows based machine to stop resource hogging and lock ups
DoEvents
Next
Set Fldr = Nothing
Suivant sur la découverte d'un fichier texte que nous voulons créer une feuille de calcul et importer le texte. Dans l'intérêt de cet exemple, tout sera également fait dans un nouveau classeur.
Dim WkBk As Workbook
Dim WkBk_Tmp As Workbook
Dim WkSht As Worksheet
Dim WkSht_Tmp As Worksheet
Dim StrName As String
'Create a new workbook
Set WkBk = Application.Workbooks.Add
'...
'Collect the name (i.e. AA from AA.txt)
StrName = Left(Fl.Name, Len(Fl.Name) - 4)
'Create a new worksheet in out new workbook
Set WkSht = WkBk.Worksheets.Add
'Change the worksheet name to the file name
WkSht.Name = StrName
'Open the file in Excel
Set WkBk_Tmp = Application.Workbooks.Open(Fl.Path)
Set WkSht_Tmp = WkBk_Tmp.Worksheets(1)
'Copy its contents into out worksheet
WkSht_Tmp.Cells.Copy WkSht.Cells
Set WkSht_Tmp = Nothing
'Close the file
WkBk_Tmp.Close 0
Set WkBk_Tmp = Nothing
Ensuite, nous voulons insérer l'image si elle est là: -
Dim Rng As Range
'...
'See it a bmp file exists (i.e. AA.bmp)
If FSO.FileExists(Fldr.Path & "\" & StrName & ".bmp") Then
'This get the bottom row of data as a position to insert the image
Set Rng = WkSht.Range(WkSht.Range("A1").End(xlDown).Address).Next(2, 0)
'Add the picture
WkSht.Shapes.AddPicture Fldr.Path & "\" & StrName & ".bmp", msoFalse, msoCTrue, Rng.Left, Rng.Top, -1, -1
Set Rng = Nothing
End If
Si nous mettons tout ce qui précède ensemble, il semble que ci-dessous, nous espérons que cela a été l'éducation dans ce qui se passe dans la code, quelques bonnes pratiques, comment aborder une tâche.
Option Explicit
Sub ExtractData()
Dim FSO As New FileSystemObject
Dim Fldr As Folder
Dim Fl As File
Dim WkBk As Workbook
Dim WkBk_Tmp As Workbook
Dim WkSht As Worksheet
Dim WkSht_Tmp As Worksheet
Dim StrName As String
Dim Rng As Range
'Create a new workbook
Set WkBk = Application.Workbooks.Add
'First we set Fldr to be the folder we care about
Set Fldr = FSO.GetFolder("C:\Users\garye\Desktop\Work")
'Then start a loop to look through each file in the folder
For Each Fl In Fldr.Files
'If the files ends in .txt then we care about it (UCASE used to make it case insensitive)
If Right(UCase(Fl.Name), 4) = ".TXT" Then
'Collect the name (i.e. AA from AA.txt)
StrName = Left(Fl.Name, Len(Fl.Name) - 4)
'Create a new worksheet in out new workbook
Set WkSht = WkBk.Worksheets.Add
'Change the worksheet name to the file name
WkSht.Name = StrName
'Open the file in Excel
Set WkBk_Tmp = Application.Workbooks.Open(Fl.Path)
Set WkSht_Tmp = WkBk_Tmp.Worksheets(1)
'Copy its contents into out worksheet
WkSht_Tmp.Cells.Copy WkSht.Cells
Set WkSht_Tmp = Nothing
'Close the file
WkBk_Tmp.Close 0
Set WkBk_Tmp = Nothing
'See it a bmp file exists (i.e. AA.bmp)
If FSO.FileExists(Fldr.Path & "\" & StrName & ".bmp") Then
'This get the bottom row of data as a position to insert the image
Set Rng = WkSht.Range(WkSht.Range("A1").End(xlDown).Address).Next(2, 0)
'Add the picture
WkSht.Shapes.AddPicture Fldr.Path & "\" & StrName & ".bmp", msoFalse, msoCTrue, Rng.Left, Rng.Top, -1, -1
Set Rng = Nothing
End If
Set WkSht = Nothing
End If
'Do events returns the processor to the system for any other items to be process
'very useful in a loop on a Windows based machine to stop resource hogging and lock ups
DoEvents
Next
Set Fldr = Nothing
Set WkBk = Nothing
MsgBox "Done!"
End Sub
Oh My Gosh! J'apprécie vraiment sur ce détail et l'explication patiente! Cela m'aide beaucoup et me fait mieux comprendre le code VBA! Merci pour votre effort, code génial! Cordialement – Irene94