Microsoft 365 Basculer les formules relatives d'une plage en absolues

ActiveCell = Application.ConvertFormula(ActiveCell.Formula, xlA1, xlA1, xlAbsolute)

Dim c As Range
For Each c in Selection
    c = Application.ConvertFormula(c.Formula, xlA1, xlA1, xlAbsolute)
Next

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