XL 2019 Procédure VBA - Adresses absolues

Sub EnAbsolu()
    Chaine = [B3].Formula
    If Mid(Chaine, 5, 1) <> "$" Then Chaine = Mid(Chaine, 1, 4) & "$" & Mid(Chaine, 5)
    If Mid(Chaine, 10, 1) <> "$" Then Chaine = Mid(Chaine, 1, 9) & "$" & Mid(Chaine, 10)
    If Mid(Chaine, 15, 1) <> "$" Then Chaine = Mid(Chaine, 1, 14) & "$" & Mid(Chaine, 15)
    [B3].Formula = Chaine
End Sub

Sub Convertir_F_ref_absolue_II()
Dim Mycell As Range
Dim Plage As Range
Set Plage = Application.InputBox(Prompt:= _
"Veuillez sélectionner les cellules à dollariser", _
Title:="Addressage absolu", Type:=8)
For Each Mycell In Plage
          If Len(Mycell.Formula) > 0 Then
                'Stores cell's formula as variable
                MyFormula = Mycell.Formula
                'Converts formula to absolute reference style
                NewFormula = Application.ConvertFormula _
                    (Formula:=MyFormula, _
                    fromReferenceStyle:=xlA1, _
                    toReferenceStyle:=xlA1, _
                    toAbsolute:=xlAbsolute)
                'Replaces old formula with new absolute formula
                Mycell.Formula = NewFormula
            End If
        Next
End Sub

Sub Convertir()
Dim cel As Range
For Each cel In Intersect(Selection, ActiveSheet.UsedRange)
  If cel.HasFormula Then _
    cel.Formula = Application.ConvertFormula(cel.Formula, xlA1, , True)
Next
End Sub

Sub Dollars()
   Dim RgSel As Range, Rg As Range
   Set RgSel = Selection
   For Each Rg In RgSel: Dollars1Cel Rg: Next Rg
   End Sub
Private Sub Dollars1Cel(ByVal Rg As Range)
   Dim ZOrg As String, lig As Long, Col As Long, SplO() As String, ZRés As String, N As Long, _
      Maju As String, P As Long, C As String * 1, SplF() As String ', PDéb As Long, PFin As Long
   ZOrg = Rg.FormulaR1C1: If ZOrg = "" Then Exit Sub
   lig = Rg.Row: Col = Rg.Column
   SplO = Split(ZOrg, "["): ZRés = SplO(0)
   For N = 1 To UBound(SplO)
      Maju = ""
      For P = Len(ZRés) To 1 Step -1
         C = Mid$(ZRés, P, 1): If C = LCase(C) Then Exit For
         Maju = C & Maju: Next P
      If Maju = "R" Then
         SplF = Split(SplO(N), "]"): ZRés = ZRés & lig + SplF(0) & SplF(1)
      ElseIf Maju = "C" Or Maju = "RC" Then
         SplF = Split(SplO(N), "]"): ZRés = ZRés & Col + SplF(0) & SplF(1)
      Else
         ZRés = ZRés & "[" & SplO(N)
         End If
      Next N
   If ZRés <> ZOrg Then
      On Error Resume Next
      Application.Calculation = xlCalculationManual
      If Rg.HasArray Then
         Rg.CurrentArray.FormulaArray = Application.ConvertFormula(ZRés, xlR1C1, xlA1) ', RelativeTo:=Rg.CurrentArray)
         If Err Then MsgBox "Range(" & Rg.CurrentArray.Address(True, True) & ").FormulaArray =" _
            & vbLf & """" & ZRés & """ ==> erreur " & Err.Number & " :" _
            & vbLf & Err.Description, vbExclamation, "Mettre les ""$""."
      Else
         Rg.FormulaR1C1 = ZRés
         If Err Then MsgBox "Range(" & Rg.Address(True, True) & ").FormulaR1C1 =" _
            & vbLf & """" & ZRés & """ ==> erreur " & Err.Number & " :" _
            & vbLf & Err.Description, vbExclamation, "Mettre les ""$""."
         End If
      Application.Calculation = xlCalculationAutomatic
      On Error GoTo 0
      End If
   End Sub