Il transforme les nombres 1.2345E67, 1.234E-15, 0.245E+28 en 1.2345 x 10⁶⁷, 1.234 x 10^-15 , 0.245 x 10²⁸

Avertissement

Ce programme ne fonctionne que si les nombres ne sont pas dans des cellules. Si les nombres sont séparés par des caractères du style tabulation (dans le cas d’un tableau importé), cet algorithme fonctionne.

Ce programme s’appuie sur le code trouvé à l’URL suivante https://superuser.com/questions/1142900/scientific-notation-in-microsoft-word

Les lignes 47 à 63 correspondent à la procédure rechercherEtRemplacer qui est une variante de celle écrite pour terminator3.

Sub ConvNbEnNotationScientifiqueNormalisee()
 
  ' Ce programme s’appuie sur le code trouvé à l’URL suivante https://superuser.com/questions/1142900/scientific-notation-in-microsoft-word
   reponse = MsgBox("Voulez-vous des espaces insécables avant ET Apres la croix de multiplication ?", vbYesNo, "Avertissement")
   If (reponse = vbYes) Then
 
   
    ' put in general form
    Call rechercherEtRemplacer("([0-9.]@)E([-+0-9]@)([!0-9])", "\1##x10§§\2##\3", True)
     
    ' take out leading 0 exponents  - Transforme un 10^+037 en 10^+37
     Call rechercherEtRemplacer("§§+0", "§§+", False)
          
    ' take out + exponents  - Transforme un 10^+20 en 10^20
 
     Call rechercherEtRemplacer("§§+", "§§", False)
     
  ' take out leading 0 exponents for negative numbers - Transforme un 10^-020   en 10^-20
    Call rechercherEtRemplacer("§§-0", "§§-", False)
     
    ' elevate exponents - met en superscript la puissance de 10
    Call rechercherEtRemplacerSuperscript("§§([-+0-9]@)##", "§§\1", True)
     
    Dim CroixMultiplication  As String
    Dim EspaceInsecable  As String
    FuturEventuelEspaceInsecable = "<futureventuelespaceinsecable>"
    CroixMultiplication = ChrW$(215)
 
   ChaineRemplacement = FuturEventuelEspaceInsecable & _
     CroixMultiplication & FuturEventuelEspaceInsecable & 10
     
    ' free up x10
    Call rechercherEtRemplacer("##x10§§", ChaineRemplacement, False)
     
    ' enleve les chaines "<futureventuelespaceinsecable>" et remplace par des espaces insecables si l'option est activé
    If (reponse = vbYes) Then
        ChaineRemplacement = "^s"
     Else
         ChaineRemplacement = ""
    End If
    Call rechercherEtRemplacer(FuturEventuelEspaceInsecable, ChaineRemplacement, False)

  End if
     
End Sub
 
Sub rechercherEtRemplacer(texteAChercher, texteDeRemplacement, OptionCaractereGenerique)
 Selection.Find.ClearFormatting
 Selection.Find.Replacement.ClearFormatting
 With Selection.Find
  .Text = texteAChercher
  .Replacement.Text = texteDeRemplacement
  .Forward = True
  .Wrap = wdFindContinue
  .Format = False
  .MatchCase = False
  .MatchWholeWord = False
  .MatchWildcards = OptionCaractereGenerique
  .MatchSoundsLike = False
  .MatchAllWordForms = False
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
End Sub
 
Sub rechercherEtRemplacerSuperscript(texteAChercher, texteDeRemplacement, OptionCaractereGenerique)
 Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = True
        .Subscript = False
    End With
 With Selection.Find
  .Text = texteAChercher
  .Replacement.Text = texteDeRemplacement
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True   '<---- ATtention, cette valeur doit etre à True
  .MatchCase = False
  .MatchWholeWord = False
  .MatchWildcards = OptionCaractereGenerique
  .MatchSoundsLike = False
  .MatchAllWordForms = False
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
End Sub