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
.
