ECRITURE DE VALEUR EN UTILISANT LES FORMATS D'ÉCRITURE DU FORTRAN

Function fFormat(ByVal valeur As Variant, strFormat As String) As String
' mise en forme du type fortran In, In.m, Fn.m, An
'
' permet l'écriture d'une valeur avec une longueur fixe
'
Dim nbCar As Integer, nbDeci As Integer, posPoint As Integer, nbZero As Integer

posPoint = InStr(1, strFormat, ".")
If posPoint > 0 Then
   nbCar = Val(Mid(Left(strFormat, posPoint - 1), 2))
   nbDeci = Val(Mid(strFormat, posPoint + 1))
Else
   nbCar = Val(Mid(strFormat, posPoint + 2))
   nbDeci = 0
End If
If Left(strFormat, 1) = "I" Then
   '--- mise en forme des entiers ---
'   3 possibilités :
'   In : chaine de caractères de longueur n tronquée à droite si necessaire
'   I  : chaine de longueur égale à la longueur de la chaine à mettre en forme
'
   fFormat = Format(valeur, "0")
   If nbDeci > nbCar Then nbDeci = nbCar
   If strFormat <> "I" Then
      If Len(fFormat) > nbCar Then
         fFormat = String(nbCar, "*")
      Else
         If nbDeci > 0 Then
            nbZero = nbDeci - Len(fFormat)
            If nbZero < 0 Then nbZero = 0
            fFormat = String(nbZero, "0") & fFormat
         End If
         fFormat = String(nbCar - Len(fFormat), " ") & fFormat
      End If
   End If
ElseIf Left(strFormat, 1) = "F" Then
   '--- mise en forme des réels ---
   fFormat = Format(valeur, "#." & String(nbDeci, "0"))
   If Len(fFormat) > nbCar Then
      fFormat = String(nbCar, "*")
   Else
      fFormat = String(nbCar - Len(fFormat), " ") & fFormat
   End If
ElseIf Left(strFormat, 1) = "A" Then
'   --- mise en forme des textes ---
'   2 possibilités :
'   An : chaine de caractères de longueur n tronquée à droite si necessaire
'   A  : chaine de longueur égale à la longueur de la chaine à mettre en forme
'
   If strFormat <> "A" Then
      If Len(valeur) > nbCar Then
         'chaine de longueur > longueur d'écriture autorisée -> troncation
         fFormat = Left(valeur, nbCar)
      Else
         'ajout de blancs pour atteindre la longueur voulue
         fFormat = valeur & String(nbCar - Len(valeur), " ")
      End If
   Else
      fFormat = valeur
   End If
ElseIf Right(strFormat, 1) = "X" Then
'   --- mise en forme d'espaces ---
'   nX : chaine composée de n espaces
   fFormat = String(Val(Left(strFormat, Len(strFormat) - 1)), " ")
Else
   fFormat = ""
End If
End Function