De: Laurent Longre <laurent.longre@free.fr>
Objet: Re: "Impossible" n'est pas romain
Date : mardi 3 octobre 2000 09:43


"J@C" a &eacute;crit :
> 
> =ROMINVERSE(LL)  donne 0, ça commence plutôt mal !

Oups ! Lamentable erreur que je corrige illico (avec quelques autres
am&eacute;liorations) :

'===========================================

Private Const Symb As String = "IVXLCDM"

Function ROMINVERSE(Nombre As String)
  
  Dim I As Integer, J As Integer
  Dim K As Integer, L As Integer, S As Integer
  Dim C As String * 1, Prec As Boolean
  
  On Error GoTo Erreur
  I = Len(Nombre)
  Do
    K = InStr(1, Symb, Mid$(Nombre, I, 1))
    If K = 0 Or K = J Then Err.Raise xlErrValue
    S = IIf(K Mod 2, 1, 5) * 10 ^ ((K - 1) \ 2)
    If K < J Then
      If Not Prec Then Err.Raise xlErrValue
      Select Case Mid$(Nombre, I, 2)
        Case Is = "ID", Is = "IM", Is = "VX", Is = "VD", _
        Is = "VM", Is = "LC", Is = "DM"
          Err.Raise xlErrValue
      End Select
      ROMINVERSE = ROMINVERSE - S
      I = I - 1
      Prec = False
    ElseIf K Mod 2 Then
      C = Mid$(Symb, K, 1)
      L = 0
      Do
        If Mid$(Nombre, I, 1) = C Then
          If L = 3 Then Err.Raise xlErrValue
          ROMINVERSE = ROMINVERSE + S
          I = I - 1
          L = L + 1
        Else
          Prec = L = 1
          Exit Do
        End If
      Loop While I
    Else
      ROMINVERSE = ROMINVERSE + S
      I = I - 1
      Prec = True
    End If
    J = K
  Loop While I
  Exit Function
  
Erreur:
  ROMINVERSE = CVErr(Err)

End Function

'===========================================

> =ROMINVERSE(CC)   donne 200, n'y aurait-il pas un peu de favoritisme ?
> mais je vous rassure,
> =ROMINVERSE(JPS), =ROMINVERSE(MHD), =ROMINVERSE(Nicolas) ou
> =ROMINVERSE(J@C),
> tous dans le même sac, ça donne #VALEUR!

Une tellle absence de galanterie est abjecte (n'ayons pas peur des
mots), et je prie MHD d'accepter mes plus humbles excuses. Quant au
reste, j'ai bien peur que ma fonction soit parfaitement objective.

Pour "MHD", je proposerais le patch suivant :

......
On Error GoTo Erreur
Select Case Nombre
  Case "MHD"
    ROMINVERSE = 200
    Exit Function
  Case "LL", "J@C", "JPS"
    Err.Raise xlErrNull
  Case "Jean-Louis"
    Err.Raise xlErrName
  Case "Nicolas"
    Err.Raise xlErrDiv0
End Select

Cordialement,

Laurent 