Afficher un message
Vieux 19/02/2005, 15h33   #7 (permalink)
michel
Guest
 
Messages: n/a
Par défaut Re: Recherche d'un fichier dans un répertoire et un boucle...

rebonjour Carlos

il ne faut pas essayer de synthetiser les 2 exemples car ils n'ont rien a voir l'un avec l'autre : ce sont des methodes totalement differentes

je ne suis pas sur d'avoir bien compris ta question , mais l'exemple ci dessous permet de remplacer tous les module1 pour ls classeurs d'un repertoire ( et sous repertoires ) , par un nouveau Module1 "C:\Module1.bas"

ATTENTION : si tu debutes en VBA , je te conseilles de faire très attention pour ne pas faire de betises sur des classeurs que tu ne souhaiterais pas modifier , car tous les "Module1" vont etre affectés !

il faut en plus activer la reference Microsoft Visual Basic for Applications Extensibility 5.3



Sub FichiersXLS_Repertoire_RemplacementModule()
Dim Dossier As String

Application.ScreenUpdating = False

Dossier = "C:\EPS1" 'adapter le chemin
ListFilesInFolder Dossier, True

Application.ScreenUpdating = True

End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' adapté de Ole P Erlandsen
'necessite d'activer la reference Microsoft Scripting RunTime
'***********
'necessite d'activer la reference
'Microsoft Visual Basic for Applications Extensibility 5.3
'***********
'
' *******!!!!!!!! Attention !!!!!!!!!******************
' cet exemple remplace tous les Module1 du repertoire
'
'********************************************
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim Cible As String
Dim Wb As Workbook
Dim VBComp As Object

Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(SourceFolderName)

For Each FileItem In SourceFolder.Files

If FileItem.Type = "Feuille de calcul Microsoft Excel" Then

'************************************************* ***********
' le chemin du nouveau module à importer
Cible = "C:\Module1.bas"

'ouvrir les classeurs
Set Wb = Workbooks.Open(Filename:=SourceFolderName & "\" & FileItem.Name)

'verifie prealablement si le module existe dans le classeur ouvert
On Error Resume Next
Set VBComp = Wb.VBProject.VBComponents("Module1").CodeModule
On Error GoTo 0

If Not VBComp Is Nothing Then

With Wb.VBProject.VBComponents
.Remove .Item("Module1") 'supprime le module existant
.Import Cible 'remplace par le nouveau module
End With

End If

Wb.Close True 'refermer le classeur

'************************************************* *********
End If

Next FileItem

If IncludeSubfolders Then
For Each SubFolder In SourceFolder.subfolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If

End Sub



bon apres midi
MichelXld