Contribuisco con la "funzione" SpellIt; partendo da un numero si puo' ottenere il suo spelling con la formula
- Codice: Seleziona tutto
=SpellIt(IlNumero;iDecimali)
La parte iDecimali e' opzionale, di default si usa "2"; i numeri negativi vengono precedti dal segno "meno".
Per mia comodita' avevo separato le "migliaia" con il "punto"; ad esempio ventottomila.ottocentoottantotto/20; nel listing e' ben evidente dove modificare se si preferisce il meno comprensibile ventottomilaottocentoottantotto/20.
Max capacita', per scelta, impostata a +/- 2.147.483.647; chi ha esigenze superiori puo' pagare un programmatore per eliminare questo limite
Il codice va messo in un Modulo standard, facendo in modo che la Option Base sia in testa a tutto:
- Codice: Seleziona tutto
Option Base 1
Dim sSpell As String
Function SpellIt(ByVal myValore As Double, Optional ByVal myDec As Integer = 2) As String
'traduce un valore nel suo spelling, by Anthony47
'
'Uso:
' =SPELLIT(ValoreNumerico [;NumDecimali])
' NumDecimali e' opzionale, di default viene usato 2
'
'Esempio
'=SPELLIT(456,789) restituira' "quattrocentocinquantasei/79"
'
'Max ValNumerico = 2.147.483.647
'I Negativi vengono rappresentati come "-(Spelling)"
'
Dim sValore As String, sPotenza, uPotenza, I As Long, myMille As String, vValore As Long
'
sSpell = ""
'Valori chiave e sostituzioni
sPotenza = Array("miliardi.", "milioni.", "mila.", "")
uPotenza = Array("unmiliardo.", "unmilione.", "mille.", "")
'
sValore = Format(Abs(Fix(myValore)), "000000000000")
vValore = Int(Abs(myValore))
'
For I = 1 To 4 '4 blocchi "migliaia"
myMille = Mid(sValore, 1 + (I - 1) * 3, 3)
If CLng(myMille) > 0 Then
If CLng(myMille) = 1 Then
sSpell = sSpell & uPotenza(I)
Else
sSpell = sSpell & sMille(myMille) & sPotenza(I)
End If
End If
Next I
'Compila spelling
If sSpell = "" Then sSpell = "zero"
If myDec > 0 Then myVirg = "/" & Round((Abs(myValore) - vValore) * (10 ^ myDec), 0)
SpellIt = sSpell & myVirg
If myValore < 0 Then SpellIt = "-(" & SpellIt & ")"
End Function
Function sMille(ByVal sBlocco As String) As String
Dim vNum, sNum, vBlocco As Long, nwBlocco As String, strNum As String
Dim Iv As Long
'
'Valori chiave
vNum = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, _
30, 40, 50, 60, 70, 80, 90, 100)
sNum = Array("", "uno", "due", "tre", "quattro", "cinque", "sei", "sette", "otto", "nove", "dieci", "undici", _
"dodici", "tredici", "quattordici", "quindici", "sedici", "diciassette", "diciotto", "diciannove", "venti", _
"trenta", "quaranta", "cinquanta", "sessanta", "settanta", "ottanta", "novanta", "cento")
If Len(sBlocco) > 3 Then 'Sara' sempre Falso
sMille = "#####": Exit Function
End If
'
strNum = sBlocco
ReBlk:
vBlocco = CLng(strNum)
If vBlocco > 99 Then
nwBlocco = Left(strNum, 1)
If vBlocco > 199 Then
txt1 = sMille(nwBlocco) & "cento"
strNum = Replace(strNum, nwBlocco, "", 1, 1)
Else
txt1 = "cento"
strNum = Replace(strNum, nwBlocco, "", 1, 1)
End If
End If
If vBlocco > 199 Then GoTo ReBlk
If vBlocco <= 20 Then GoTo Fase3
Fase2:
vBlocco = CLng(strNum)
CPart = Application.Match(vBlocco, vNum)
txt2 = sNum(CPart)
CVal = vNum(CPart)
vBlocco = vBlocco - CVal
Fase3:
If vBlocco > 0 Then
txt3 = sNum(vBlocco + 1)
' txt3 = sMille(Format(vBlocco, "0"))
End If
'
'Compila spelling
If (Left(txt3, 1) = "u" Or Left(txt3, 1) = "o") And Len(txt2) > 0 Then _
txt2 = Left(txt2, Len(txt2) - 1)
sMille = txt1 & txt2 & txt3
End Function
Ciao a tutti.
EDIT: Vedere Versione2 con correzioni a pag 2