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
| Sub Proceed()
Dim VBComp As VBComponent
Dim OriginalCode, VB7Code, Module, Recherche As String
Dim Chemin, TargetFile, VB7File, ThisFileName As String
Dim i, LineMax, LineCodeMax, Line, LineCode As Integer
Dim Test64b As Boolean
'Test si Office 64bits installé. Sinon, fermeture de la procédure
#If Win64 Then
Test64b = True
#End If
If Test64b = False Then
MsgBox "Office 64 bits is not installed in your PC. Script will be stopped."
Exit Sub
End If
Application.ScreenUpdating = False
LineMax = Range("A65536").End(xlUp).Row ' Fin de la table de fichiers à traiter
LineCodeMax = Sheets("VBA Datas").Range("A65536").End(xlUp).Row 'Fin de la table de codes vba à corriger
ThisFileName = ActiveWorkbook.Name
Chemin = ActiveWorkbook.Path & "\"
For Line = 4 To LineMax 'loop sur la liste de fichiers à traiter
If Workbooks(ThisFileName).Sheets("Process").Cells(Line, 2) <> "" Then 'Test si le fichier selectionné est vraiment à traiter ou non
TargetFile = Workbooks(ThisFileName).Sheets("Process").Cells(Line, 1) 'Non du fichier à traiter
VB7File = Workbooks(ThisFileName).Sheets("Process").Cells(Line, 3) 'Nom du fichier après traitement
Application.EnableEvents = False
Application.DisplayAlerts = False
Workbooks.Open Chemin & TargetFile, UpdateLinks:=3 'Ouvre le fichier à traiter
'Vérification Fichier ouvert par un autre utilisateur
If Workbooks(TargetFile).ReadOnly = True Then
MsgBox (TargetFile & " is already opened by another User" & Chr(13) & _
"Please close it and try again")
Exit Sub
End If
'Traitement des lignes de code - Remplacement de l'ancien code par le nouveau
For LineCode = 2 To LineCodeMax
Module = Workbooks(ThisFileName).Sheets("VBA Datas").Cells(LineCode, 1)
OriginalCode = Workbooks(ThisFileName).Sheets("VBA Datas").Cells(LineCode, 2)
VB7Code = Workbooks(ThisFileName).Sheets("VBA Datas").Cells(LineCode, 3)
Set VBComp = ActiveWorkbook.VBProject.VBComponents(Module)
With VBComp
For i = 1 To .CodeModule.CountOfLines
Recherche = .CodeModule.Lines(i, 1)
Recherche = Replace(Recherche, OriginalCode, VB7Code)
.CodeModule.ReplaceLine i, Recherche
Next
End With
Next LineCode
' Enregistrement et fermeture du fichier après traitement
ActiveWorkbook.SaveAs Filename:=Chemin & VB7File, FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close savechanges:=False
Workbooks(ThisFileName).Sheets("Process").Cells(Line, 4) = "Done"
End If
Next Line
Application.Calculation = xlAutomatic
End Sub |
Partager