formule relatives vers absolues

[cora]

Bonjour à tous,

Y a t'il un moyen sur une plage de cellule comportant des formules, qu'elles deviennent toutes absolues genre:
B52=$B$52 et ce sur plusieurs cellules en même temps. Cela me ferais gagner un temps énorme..

Merci de votre aide

 

[Dranreb]

Re : formule relatives vers absolues

Bonjour.
J'ai une macro affectée à un bouton de barre d'outil, qui ne fait pas exactement ça, mais plus utile en pratique:
Elle ne rend absolues que les références vers d'autres lignes et colonnes que celles de la cellule portant la formule :

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 = ZRés
      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

Cordialement.

 

[cora]

Re : formule relatives vers absolues

merci j'en ai trouvé une qui semble bien fonctionner en sélectionnant la plage de cellules concernées
Sub test1()
Dim c As Range
For Each c In Selection.SpecialCells(xlFormulas)
c.Formula = Application.ConvertFormula(c.Formula, xlA1, xlA1,
xlAbsolute)
Next c
End Sub