Option Explicit
Public CelluleBase As Range
Public FormuleBase As String
Public FormuleLocal As String
Sub ChangeFormula()
Dim FinCell As Range, xCell As Range, Parformule As String
If CelluleBase Is Nothing Then
Set CelluleBase = Nothing
On Error Resume Next
Set CelluleBase = Application.InputBox("Sélectionnez la cellule dont vous voulez-modifiez la formule", _
Type:=8)
If Err.Number <> 0 Then
MsgBox "Erreur: " & Err.Description & " => FIN"
Set CelluleBase = Nothing: QuoiFaire.Caption = "Choisir la formule..."
Exit Sub
End If
If CelluleBase Is Nothing Then
MsgBox "Aucune cellule sélectionnée => FIN"
Set CelluleBase = Nothing: QuoiFaire.Caption = "Choisir la formule..."
Exit Sub
End If
If CelluleBase.Count <> 1 Then
MsgBox "Plus d'une cellule sélectionnée => FIN"
Set CelluleBase = Nothing: QuoiFaire.Caption = "Choisir la formule..."
Exit Sub
End If
If CelluleBase.Column <> Columns("d").Column Then
MsgBox "Cellule non élément dela colonne D => FIN"
Set CelluleBase = Nothing: QuoiFaire.Caption = "Choisir la formule..."
Exit Sub
End If
FormuleBase = CelluleBase.FormulaR1C1
FormuleLocal = CelluleBase.FormulaLocal
MsgBox "Veuillez modifier la formule de la cellule " & CelluleBase.Address(False, False) & _
vbLf & "de formule: " & CelluleBase.FormulaLocal
QuoiFaire.Caption = "Modifier les cellules semblables..."
CelluleBase.Select
Else
Parformule = CelluleBase.FormulaR1C1
If MsgBox("Vous allez modifier les formules de la colonne D" & vbLf & _
"les formules telles que " & FormuleLocal & vbLf & _
"seront remplacées par " & CelluleBase.FormulaLocal & vbLf & _
"Voulez-vous continuer ?", vbExclamation + vbYesNo + vbDefaultButton2) <> vbYes Then
Set CelluleBase = Nothing: QuoiFaire.Caption = "Choisir la formule..."
Exit Sub
End If
Set FinCell = _
Columns("d").Find(What:="*", _
After:=Columns("d").Cells(1), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If FinCell Is Nothing Then
MsgBox "pas cellule avec formule => FIN"
Set CelluleBase = Nothing: QuoiFaire.Caption = "Choisir la formule..."
Exit Sub
End If
For Each xCell In Range(Cells(1, "d"), FinCell)
If xCell.FormulaR1C1 = FormuleBase Then xCell.FormulaR1C1 = CelluleBase.FormulaR1C1
Next xCell
Set CelluleBase = Nothing
QuoiFaire.Caption = "Choisir la formule..."
End If
End Sub
Private Sub QuoiFaire_Click()
ChangeFormula
End Sub
