Sub RemplacerLignesVBC(Module As String, ZC As String, ByVal RgZ As Range, Optional ByVal N As Long = 0)
Dim V As Variant, Z As String, ZAct As String, L As Long, C As Long, Lf As Long, Cf As Long, Sh As Shape
V = RgZ.Value: Z = ""
If IsArray(V) Then
For L = 1 To UBound(V, 1): Z = Z & IIf(Z <> "", vbLf, "") & V(L, 1): Next L
Else
Z = V: End If
If N = 0 Then
C = InStr(Z, vbLf): If C = 0 Then C = Len(Z) + 1
While C > 0: N = N + 1: C = InStr(C + 1, Z, vbLf): Wend
N = N + 1 'intervalles lignes + 1
End If
L = 1: C = 1: Lf = -1: Cf = -1
With ActiveWorkbook.VBProject.VBComponents(Module).CodeModule
If .Find(ZC, L, C, Lf, Cf) Then
ZAct = Replace(.Lines(L, N), vbCrLf, vbLf)
If ZAct = Z Then MsgBox "Le code actuel est déjà celui-ci.", _
vbInformation, "Visual Basic for Application": Exit Sub
Set Sh = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, _
Rows(ActiveWindow.ScrollRow).Top + 10, 10, 10)
Sh.Fill.ForeColor.RGB = RGB(0, 0, 194)
With Sh.TextFrame.Characters.Font: .Name = "Consolas": .FontStyle = "Gras": .Size = 12: .ColorIndex = 2: End With
For C = 1 To Len(ZAct) Step 255
Sh.TextFrame.Characters(C).Insert Mid$(ZAct, C, 255): Next C
Sh.TextFrame.AutoSize = True
For C = 1 To Max(Len(Z), Len(ZAct))
If Mid$(Z, C, 1) <> Mid$(ZAct, C, 1) Then Exit For
Next C
If MsgBox("Le code actuel est différent à partir du " & C & "ième caractère :" _
& vbLf & """" & Replace(Mid$(ZAct, C, 40), vbLf, "{Lf}") & "…"" à remplacer par :" _
& vbLf & """" & Replace(Mid$(Z, C, 40), vbLf, "{Lf}") & "…""" _
& vbLf & "Confirmez le remplacement de ce code.", _
vbOKCancel + vbInformation, "Visual Basic for Application") = vbOK Then
C = 1
Do
Cf = InStr(C, Z, vbLf): If Cf = 0 Then Cf = Len(Z) + 1
If N > 0 Then .ReplaceLine L, Mid$(Z, C, Cf - C) Else .InsertLines L, Mid$(Z, C, Cf - C)
L = L + 1: N = N - 1: C = Cf + 1: Loop Until C > Len(Z)
End If
Sh.Delete
Else
MsgBox """" & ZC & """ n'a pas été trouvé dans le module """ & Module & """.", _
vbCritical, "Visual Basic for Application"
End If
End With
End Sub
