Bonsoir,
Voilà la macro en question
Sub CalculeSurface()
'
' Macro11 Macro
' Macro enregistrée le 02/12/2002 par tis01
'
'
Dim I As Long
Application.ScreenUpdating = False
For I = 8 To 2000
Range("I" & I).Value = CalSurface(I)
Next I
Application.ScreenUpdating = True
End Sub
Public Function CalSurface(NumLigne As Long) As Variant
Dim MyTexte As String
Dim PosCara As Integer
Dim ValA As Long
Dim ValB As Long
MyCell = "F" & NumLigne
MyCell2 = "E" & NumLigne
MyTexte = Range(MyCell).Text
MyTexte2 = Range(MyCell2).Text
'Test si il y a un x minuscule
PosCara = InStr(1, UCase(MyTexte), "X")
If PosCara <> 0 Then
ValA = Val(Left(MyTexte, PosCara - 1))
ValB = Val(Right(MyTexte, Len(MyTexte) - PosCara))
CalSurface = Format(1.3 * (ValA * ValB) / 1000000, "# ###.###")
Else
CalSurface = Format(1.1 * Val(MyTexte) / 1000, "# ###.###")
End If
If CalSurface = 0 Or CalSurface = " ." Or CalSurface = " ," Then
CalSurface = ""
Else
CalSurface = CalSurface * Val(MyTexte2)
End If
End Function