Function Theosophique(pvarAnything)
'*auteur : harfang
' Calcule la « valeur thésophique » d'une chaîne de
' caractères, en tenant comptes des accentués.
'
Dim intPos As Integer
Dim strC As String
Dim intA As Integer
Dim intSum As Integer
For intPos = 1 To Len(pvarAnything & "")
strC = UCase(Mid$(pvarAnything, intPos, 1))
Select Case strC
' cas particuliers:
Case "Æ": intSum = intSum + Theosophique("AE")
Case "?": intSum = intSum + Theosophique("OE")
Case "ß": intSum = intSum + Theosophique("SS")
' recherche alphabétique
Case "A" To "ZZ"
For intA = 1 To 26
If strC >= Chr(64 + intA) _
And strC < Chr(64 + intA) & "Z" Then
intSum = intSum + intA
Exit For
End If
Next intA
' chiffres...
Case "0" To "9"
intSum = intSum + Val(strC)
End Select
Next intPos
Theosophique = (intSum - 1) Mod 9 + 1
End Function