Sub RemplacerMacro()
Dim code$, wbk As Workbook, deb&, fin&
Application.ScreenUpdating = False
code = code & "Sub EFFACER_ACTIVITES()" & vbCrLf
code = code & "For i = 1 To 12" & vbCrLf
code = code & " With Sheets(Format(i, ""00""))" & vbCrLf
code = code & " .Range(""D26:N32,D34:N40,D42:N47,D49:N51,"" _" & vbCrLf
code = code & " & ""D53:N54,D56:N56,D58:N60,D62:N63,D65:N67,AH47:BL47"").ClearContents" & vbCrLf
code = code & " End With" & vbCrLf
code = code & "Next" & vbCrLf
code = code & "End sub" & vbCrLf
Set wbk = Workbooks.Open("C:\xxx\....\xxxxx.xls") ' à adapter
With wbk
If ModuleExists(wbk, "Module8") And ProcedureExists(wbk, "EFFACER_ACTIVITES", "Module8") Then
With .VBProject.VBComponents("Module8").CodeModule
debut = .ProcStartLine("EFFACER_ACTIVITES", vbext_pk_Proc)
fin = .ProcCountLines("EFFACER_ACTIVITES", vbext_pk_Proc)
.deleteLines debut, fin
.AddFromString code
End With
.Close True
Else
.Close False
End If
End With
Application.ScreenUpdating = True
End Sub
'Chip Pearson
Function ModuleExists(wb As Workbook, ModuleName As String) As Boolean
On Error Resume Next
ModuleExists = Len(wb.VBProject.VBComponents(ModuleName).Name) <> 0
End Function
'Chip Pearson
Function ProcedureExists(wb As Workbook, ProcedureName As String, ModuleName As String) As Boolean
On Error Resume Next
If ModuleExists(wb, ModuleName) = True Then
ProcedureExists = wb.VBProject.VBComponents(ModuleName) _
.CodeModule.ProcStartLine(ProcedureName, 0) <> 0
End If
End Function