1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
| Function maj()
Application.DisplayAlerts = False
Dim oFS As Office.FileSearch
Dim i, nbModulesTraites As Integer
Dim nomFichier, code1, code2 As String
Set oFS = Application.FileSearch
sRep = ActiveWorkbook.Path
' PREMIERE ETAPE : OUVRIR LE FICHIER SOURCE AVEC LE NOUVEAU CODE A RECOPIER DANS
' TOUS LES AUTRES FICHIERS *.plm
' RECUPERER LES 2 CODES MODIFIES DANS 2 STRINGS Code1 et Code2
' Fichier source (sModele) avec tout le bon code VBA
sModele = "ModeleProg.plm"
Workbooks.Open sRep & "\" & sModele
Dim vbProj As Object
Set vbProj = ActiveWorkbook.VBProject
Set Application.VBE.ActiveVBProject = vbProj
' Mot de passe "test"
SendKeys "test" & "~~"
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
DoEvents
' Recupere les 2 codes VBA à modifier ensuite dans tous les fichiers *.plm
With ActiveWorkbook.VBProject.VBComponents("Feuil5").CodeModule
code1 = .Lines(1, .CountOfLines)
End With
With ActiveWorkbook.VBProject.VBComponents("Module1").CodeModule
code2 = .Lines(1, .CountOfLines)
End With
Set vbProj = Nothing
Application.VBE.ActiveWindow.Close
ActiveWorkbook.Close True
' DEUXIEME ETAPE : recopier les 2 codes Code1 et Code2 dans tous les
'fichiers *.plm
With oFS
.NewSearch
.FileType = msoFileTypeAllFiles
.Filename = "*plm"
' Repertoire <<test>>
.LookIn = "C:\Documents and Settings\info\Bureau\test"
.Execute
nbModulesTraites = .FoundFiles.Count
For i = 1 To .FoundFiles.Count
Set wb = Workbooks.Open(.FoundFiles(i))
nomFichier = .FoundFiles(i)
Set vbProj2 = ActiveWorkbook.VBProject
Set Application.VBE.ActiveVBProject = vbProj2
' mot de passe pour l'éditeur VBA : "test"
SendKeys "test" & "~~"
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
DoEvents
' Le premier code a changer se trouve dans la feuil5
With wb.VBProject.VBComponents("Feuil5").CodeModule
.DeleteLines 1, .CountOfLines
End With
With wb.VBProject.VBComponents("Feuil5").CodeModule
.AddFromString code1
End With
' Le deuxieme code a changer se trouve dans le module1
With wb.VBProject.VBComponents("Module1").CodeModule
.DeleteLines 1, .CountOfLines
End With
With wb.VBProject.VBComponents("Module1").CodeModule
.AddFromString code2
End With
Application.VBE.MainWindow.Visible = False
Application.VBE.ActiveWindow.Close
Set vbProj2 = Nothing
MsgBox (wb.Name = ActiveWorkbook.Name)
wb.Close True
Set wb = Nothing
Next i
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Function |
Partager