Bonjour
G le code ci dessous qui me permet de remplacer tous les modules nommés 'ImporterGEP' des fichiers excel contenus dans un dossier 'EPS1'
Mon souci est que les fichiers excel ne contenant pas ce module ne devrait pas etre modifies puisque 'importergep.bas n'est pas présent(voir police rouge)...
Donc à l'instruction ci apres '.Remove .Item('importerGEP')' (en vert)
ca bug forcement puisqu'il ne peux pas fermer qqchose qui n'est ouvert .....
Sub FichiersXLS_Repertoire_RemplacementModule()
Dim Dossier As String
Dim ML As String
ML = Left(ThisWorkbook.Path, 1)
Application.ScreenUpdating = False
Dossier = ML & ':\\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 Compiler 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
Dim ML As String
ML = Left(ThisWorkbook.Path, 1)
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
'************************************************************
'MsgBox ML
'Workbooks.Open Filename:=ML & ':\\eps1\\f_ele.dbf'
' le chemin du nouveau module à importer
Cible = ML & ':\\EPS1\\Utilitaires Karl\\Module Vba Karl\\importerGEP.bas'
'ouvrir les classeurs
Set Wb = Workbooks.Open(Filename:=SourceFolderName & '\\' & FileItem.Name)
On Error Resume Next
'verifie prealablement si le module existe dans le classeur ouvert
Set VBComp = Wb.VBProject.VBComponents('importerGEP').CodeModule
On Error GoTo 0
If Not VBComp Is Nothing Then
With Wb.VBProject.VBComponents
.Remove .Item('importerGEP') 'supprime le module existant
End With
DoEvents
With Wb.VBProject.VBComponents
.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
Merci
G le code ci dessous qui me permet de remplacer tous les modules nommés 'ImporterGEP' des fichiers excel contenus dans un dossier 'EPS1'
Mon souci est que les fichiers excel ne contenant pas ce module ne devrait pas etre modifies puisque 'importergep.bas n'est pas présent(voir police rouge)...
Donc à l'instruction ci apres '.Remove .Item('importerGEP')' (en vert)
ca bug forcement puisqu'il ne peux pas fermer qqchose qui n'est ouvert .....
Sub FichiersXLS_Repertoire_RemplacementModule()
Dim Dossier As String
Dim ML As String
ML = Left(ThisWorkbook.Path, 1)
Application.ScreenUpdating = False
Dossier = ML & ':\\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 Compiler 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
Dim ML As String
ML = Left(ThisWorkbook.Path, 1)
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
'************************************************************
'MsgBox ML
'Workbooks.Open Filename:=ML & ':\\eps1\\f_ele.dbf'
' le chemin du nouveau module à importer
Cible = ML & ':\\EPS1\\Utilitaires Karl\\Module Vba Karl\\importerGEP.bas'
'ouvrir les classeurs
Set Wb = Workbooks.Open(Filename:=SourceFolderName & '\\' & FileItem.Name)
On Error Resume Next
'verifie prealablement si le module existe dans le classeur ouvert
Set VBComp = Wb.VBProject.VBComponents('importerGEP').CodeModule
On Error GoTo 0
If Not VBComp Is Nothing Then
With Wb.VBProject.VBComponents
.Remove .Item('importerGEP') 'supprime le module existant
End With
DoEvents
With Wb.VBProject.VBComponents
.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
Merci