[CERCO] Algoritmo di conversione NUM > LETTERE
Fabio Guerrazzi
Ric.Bancarie)
Esempio:
1560000
in:
UNMILIONECINQUECENTOSESSANTAMILA**************
Grazie.
Fabio Guerrazzi
Davide Oliva
>Salve. Avrei bisogno dell' algoritmo che converte i numeri in testo (stile
>Ric.Bancarie)
Ciao,
ho scaricato qualche tempo fa un OCX con le funzioni che ti servono. Non mi
ricordo più purtroppo da dove....
Se ti può interessare comunicamelo per mail e provvederò a mandartelo.
Davide.
Luca Dormio
Fabio Guerrazzi ha scritto nel messaggio <360a1...@news.mercurio.it>...
>Salve. Avrei bisogno dell' algoritmo che converte i numeri in testo (stile
>Ric.Bancarie)
>
>1560000
>in:
>UNMILIONECINQUECENTOSESSANTAMILA**************
>
>Grazie.
>
>Fabio Guerrazzi
Ecco qua; non è elegantissimo ma ho cercato di fare stare tutto in una
funzione.
Lo invio anche sul sito comune...
== Inizio Codice ==
Function NumToChar(ByVal StartValue As Variant) As String
Dim strValue As String
Dim strNum As String
Dim strResult As String
Dim i As Integer
' Controlli iniziali
' (gestisce fino a 999.999.999.999)
If Len(StartValue) > 12 Or Not IsNumeric(StartValue) Then
NumToChar = "** Valore non calcolabile **"
Exit Function
End If
If Val(StartValue) = 0 Then
NumToChar = "Zero"
Exit Function
End If
StartValue = Format(StartValue, String(12, "0"))
strResult = ""
' Inizio conversione
For i = 1 To 4
strValue = Mid$(StartValue, i * 3 - 2, 3)
' Centinaia
strNum = Mid$(strValue, 1, 1)
Select Case strNum
Case "1": strResult = strResult & "Cento"
Case "2": strResult = strResult & "Duecento"
Case "3": strResult = strResult & "Trecento"
Case "4": strResult = strResult & "Quattrocento"
Case "5": strResult = strResult & "Cinquecento"
Case "6": strResult = strResult & "Seicento"
Case "7": strResult = strResult & "Settecento"
Case "8": strResult = strResult & "Ottocento"
Case "9": strResult = strResult & "Novecento"
End Select
' Decine
strNum = Mid$(strValue, 2, 1)
Select Case strNum
Case "1"
Select Case Mid$(strValue, 3, 1)
Case "0": strResult = strResult & "Dieci"
Case "1": strResult = strResult & "Undici"
Case "2": strResult = strResult & "Dodici"
Case "3": strResult = strResult & "Tredici"
Case "4": strResult = strResult & "Quattordici"
Case "5": strResult = strResult & "Quindici"
Case "6": strResult = strResult & "Sedici"
Case "7": strResult = strResult & "Diciassette"
Case "8": strResult = strResult & "Diciotto"
Case "9": strResult = strResult & "Diciannove"
End Select
Case "2"
Select Case Mid$(strValue, 3, 1)
Case "1"
strResult = strResult & "VentUno"
Case "8"
strResult = strResult & "VentOtto"
Case Else
strResult = strResult & "Venti"
End Select
Case "3"
Select Case Mid$(strValue, 3, 1)
Case "1"
strResult = strResult & "TrentUno"
Case "8"
strResult = strResult & "TrentOtto"
Case Else
strResult = strResult & "Trenta"
End Select
Case "4"
Select Case Mid$(strValue, 3, 1)
Case "1"
strResult = strResult & "QuarantUno"
Case "8"
strResult = strResult & "QuarantOtto"
Case Else
strResult = strResult & "Quaranta"
End Select
Case "5"
Select Case Mid$(strValue, 3, 1)
Case "1"
strResult = strResult & "CinquantUno"
Case "8"
strResult = strResult & "CinquantOtto"
Case Else
strResult = strResult & "Cinquanta"
End Select
Case "6"
Select Case Mid$(strValue, 3, 1)
Case "1"
strResult = strResult & "SessantUno"
Case "8"
strResult = strResult & "SessantOtto"
Case Else
strResult = strResult & "Sessanta"
End Select
Case "7"
Select Case Mid$(strValue, 3, 1)
Case "1"
strResult = strResult & "SettantUno"
Case "8"
strResult = strResult & "SettantOtto"
Case Else
strResult = strResult & "Settanta"
End Select
Case "8"
Select Case Mid$(strValue, 3, 1)
Case "1"
strResult = strResult & "OttantUno"
Case "8"
strResult = strResult & "OttantOtto"
Case Else
strResult = strResult & "Ottanta"
End Select
Case "9"
Select Case Mid$(strValue, 3, 1)
Case "1"
strResult = strResult & "NovantUno"
Case "8"
strResult = strResult & "NovantOtto"
Case Else
strResult = strResult & "Novanta"
End Select
End Select
' Unita' (solo se le decine<>10
If Mid$(strValue, 2, 1) <> "1" Then
strNum = Mid$(strValue, 3, 1)
Select Case strNum
Case "1": strResult = strResult & "Uno"
Case "2": strResult = strResult & "Due"
Case "3": strResult = strResult & "Tre"
Case "4": strResult = strResult & "Quattro"
Case "5": strResult = strResult & "Cinque"
Case "6": strResult = strResult & "Sei"
Case "7": strResult = strResult & "Sette"
Case "8": strResult = strResult & "Otto"
Case "9": strResult = strResult & "Nove"
End Select
End If
' Ultimi aggiustamenti
Select Case i
Case 1
If strValue <> "000" Then strResult = strResult & "Miliardi"
Case 2
If strValue <> "000" Then strResult = strResult & "Milioni"
Case 3
If strValue <> "000" Then strResult = strResult & "Mila"
End Select
Select Case strResult
Case "UnoMila"
strResult = "Mille"
Case "UnoMilioni"
strResult = "UnMilione"
Case "UnoMiliardi"
strResult = "UnMiliardo"
End Select
Next
NumToChar = strResult
End Function
== Fine Codice ==
Ciao.
Luca Dormio
ldo...@tin.it
l...@ifminfomaster.com
+==========================+
Sig.la Srl
Via 5 Maggio 81
GENOVA (ITALY)
si...@ifminfomaster.com
+==========================+
steve
un bel pň di tempo.
C'č solo un piccolo Bug:
i numeri che finiscono per uno o per otto vengono convertiti in questo modo:
es. 21 -> VentUnoUno
es. 178 -> CentoSettantOttoOtto
Per ovviare a ciň basta combiare il test
....
....
' Unita' (solo se le decine<>10)
If Mid$(strValue, 2, 1) <> "1" Then ....
....
....
Con il seguente:
....
....
' Unita' (solo se le decine<>10)
If Mid$(strValue, 2, 1) <> "1" And Right$(strResult, 3) <> "Uno" And
Right$(strResult, 4) <> "Otto" Then ....
....
....
che tiene conto del fatto che un eventuale "Uno" o "Otto" č stato giŕ accodato.
Ciao, ciao.
**steve (c) 1996
*** just on the net
Gregory Biagini
<fab...@si.tdnet.it> wrote:
>Salve. Avrei bisogno dell' algoritmo che converte i numeri in testo
Eccone uno fatto da me: è contenuto tutto in una subroutine.
Riceve il numero (formato stringa, formattatto con i punti di
separazione delle migliaia) e restituisce una stringa testo.
L'ho provata, e non mi ha dato problemi... se qualcuna ha dei
suggerimenti sono ovviamente graditi!
Saluti a tutti.
Greg
gbia...@computering.it
gy...@geocities.com
http://www.geocities.com/Athens/Aegean/3276/
|###########INIZIO SUBROUTINE
'***********************************************************
'**********Routine che converte un numero in testo.*********
'*copyright by Gregory Biagini-19...@computering.it*
'***********************************************************
'***L'utilizzo di questa routine è libero, purché vengano***
'****manutenuti i riferimenti al copyright dell'autore.*****
'***********************************************************
'Num è una variabile stringa che riceve il numero da tradurre in
cifre: esso è formattato con i punti di separazione delle migliaia
(p.es. 1.000.000)
'TradF è la stringa di ritorno che contiene la trascrizione in cifre
Sub TraduciNumero (Num As String, TradF As String)
Dim Lung As Integer, Presi As Integer, Fine As Integer, i As Integer
Dim CarUn As String, CarDe As String, CarDb As String, Tmp As
String, Tmp1 As String, TmpTrad As String, Trad As String
Presi = 0
TradF = ""
Trad = ""
Lung = Len(Num)
Do
If Lung - Presi > 4 Then
Presi = Presi + 4 'prende le cifre a gruppi di
tre
Tmp = Mid$(Num, (Lung - Presi + 2), 3)
Else
Tmp = Mid$(Num, 1, (Lung - Presi))
Presi = Lung
Fine = 1
End If
Select Case Presi
Case 5 To 8, 17 To 20 'fino a 999milamiliardi! >
limite Currency (922.337.203.685.477)
If Len(Tmp) = 1 And Right$(Tmp, 1) = "1" Then
TradF = "mille" & TradF
Exit Sub
ElseIf Tmp = "001" Then
TradF = "mille" & TradF
Tmp = "000"
ElseIf Tmp <> "000" Then
TradF = "mila" & TradF
End If
Case 9 To 12
If TradF <> "" And Tmp <> "000" Then
TradF = "e" & TradF
End If
If Len(Tmp) = 1 And Right$(Tmp, 1) = "1" Then
TradF = "unmilione" & TradF
Exit Sub
ElseIf Tmp = "001" Then
TradF = "unmilione" & TradF
Tmp = "000"
ElseIf Tmp <> "000" Then
TradF = "milioni" & TradF
End If
Case 13 To 16
If TradF <> "" And Tmp <> "000" Then
TradF = "e" & TradF
End If
If Len(Tmp) = 1 And Right$(Tmp, 1) = "1" Then
TradF = "unmiliardo" & TradF
Exit Sub
Else
TradF = "miliardi" & TradF
End If
End Select
i = -1
TmpTrad = ""
Do
Trad = ""
If Tmp = "000" Then Exit Do
If Len(Tmp) = 2 Or (Len(Tmp) = 3 And i = 3) Then
CarUn = Right$(Tmp, 1)
If Len(Tmp) = 2 Then
CarDe = Left$(Tmp, 1)
Else
CarDe = Mid$(Tmp, 2, 1)
End If
If CarDe = "1" And CarUn <> "0" Then
CarDb = CarDe & CarUn
CarDe = ""
CarUn = ""
i = 0
End If
i = 2
End If
If Len(Tmp) = 3 And i = -1 Then
Tmp1 = Left$(Tmp, 1)
i = 3
CarDe = ""
CarDb = ""
If Tmp1 = "1" Then
TmpTrad = "cento"
CarUn = "0"
Else
CarUn = Tmp1
End If
End If
If Len(Tmp) = 1 Then
CarUn = Tmp
CarDe = ""
CarDb = ""
i = 0
End If
Select Case Val(CarDe)
Case Is = 1
Trad = "dieci"
Case Is = 2
Trad = "venti"
Case Is = 3
Trad = "trenta"
Case Is = 4
Trad = "quaranta"
Case Is = 5
Trad = "cinquanta"
Case Is = 6
Trad = "sessanta"
Case Is = 7
Trad = "settanta"
Case Is = 8
Trad = "ottanta"
Case Is = 9
Trad = "novanta"
End Select
If i = 2 Then 'decine
If Trad <> "" Then
If CarUn = "1" Or CarUn = "8" Then
TmpTrad = TmpTrad & Left$(Trad, (Len(Trad) - 1))
Else
TmpTrad = TmpTrad & Trad
End If
Trad = ""
End If
i = 0
End If
Select Case Val(CarUn)
Case Is = 1
Trad = "uno"
Case Is = 2
Trad = "due"
Case Is = 3
Trad = "tre"
Case Is = 4
Trad = "quattro"
Case Is = 5
Trad = "cinque"
Case Is = 6
Trad = "sei"
Case Is = 7
Trad = "sette"
Case Is = 8
Trad = "otto"
Case Is = 9
Trad = "nove"
End Select
If i = 3 And CarUn <> "0" Then 'centinaia
TmpTrad = Trad & "cento"
Trad = ""
End If
Select Case Val(CarDb)
Case Is = 11
Trad = "undici"
Case Is = 12
Trad = "dodici"
Case Is = 13
Trad = "tredici"
Case Is = 14
Trad = "quattordici"
Case Is = 15
Trad = "quindici"
Case Is = 16
Trad = "sedici"
Case Is = 17
Trad = "diciassette"
Case Is = 18
Trad = "diciotto"
Case Is = 19
Trad = "diciannove"
End Select
CarDb = ""
TmpTrad = TmpTrad & Trad
Loop Until i = 0
TradF = TmpTrad & TradF
Loop Until Fine = 1
End Sub
|###########FINE SUBROUTINE
NB: alcune linee possono essere state troncate e mandate a capo dal
newsreader...
Marco Minerva
Davide Oliva ha scritto nel messaggio <6udf5u$5au$1...@news.mclink.it>...
>>Ric.Bancarie)
>
>
>Ciao,
>ho scaricato qualche tempo fa un OCX con le funzioni che ti servono. Non mi
>ricordo più purtroppo da dove....
>Se ti può interessare comunicamelo per mail e provvederò a mandartelo.
>
>Davide.
>
>
------------
Ciao
Non penso che per una funzione così semplice sia necessario un OCX che,
inevitabilmente, appesantirebbe l'applicazione. Da qualche parte devo avere
del codice che ti può interessare. E' una vecchia routine scritta in GWBASIC
(bei tempi quelli). Se vuoi saperne di più, fammi sapere.
Ciao
Marco Minerva
http://www.geocities.com/SiliconValley/Foothills/7260
http://www.armaditaggia.com/marco
Zeus
>Ric.Bancarie)
>
>1560000
>in:
>UNMILIONECINQUECENTOSESSANTAMILA**************
>
Anch'io avrei bisogno dell'algoritmo (non di esempi o ocx)
Grazie
Zeus
Roal Zanazzi
www.dejanews.com (motore di ricerca per newsgroups), perche' su
it.comp.delphi hanno postato alcuni giorni fa la funzione gia' fatta in
Pascal (Delphi, ma penso vada bene).
P.S. Se ti servono tutti 'sti algoritmi per il Pascal, non sarebbe meglio
che tu li chiedessi su it.comp.delphi o meglio it.comp.lang.pascal ?
--
Roal Zanazzi
z...@iol.it
Salvatore Pucci
>Ric.Bancarie)
If Numero = 0 Then Exit Function
Dim Frazione2 As Integer
Dim Frazione3 As Integer
Dim Esp As Integer
Dim InLettere As String
Dim Temp As Double
dim Cifra(28) As String
Cifra(1) = ""
Cifra(2) = "uno"
Cifra(3) = "due"
Cifra(4) = "tre"
Cifra(5) = "quattro"
Cifra(6) = "cinque"
Cifra(7) = "sei"
Cifra(8) = "sette"
Cifra(9) = "otto"
Cifra(10) = "nove"
Cifra(11) = "dieci"
Cifra(12) = "undici"
Cifra(13) = "dodici"
Cifra(14) = "tredici"
Cifra(15) = "quattordici"
Cifra(16) = "quindici"
Cifra(17) = "sedici"
Cifra(18) = "diciassettte"
Cifra(19) = "diciotto"
Cifra(20) = "diciannove"
Cifra(21) = "venti"
Cifra(22) = "trenta"
Cifra(23) = "quaranta"
Cifra(24) = "cinquanta"
Cifra(25) = "sessanta"
Cifra(26) = "settanta"
Cifra(27) = "ottanta"
Cifra(28) = "novanta"
Temp = Numero / 1000 ^ Esp
Frazione1 = Int(Temp)
If Frazione1 > 0 Then
Frazione2 = Frazione1
If Frazione2 > 99 Then
Temp = Frazione2 / 100
Frazione3 = Int(Temp)
Frazione2 = Frazione2 - Frazione3 * 100
If Frazione3 = 1 Then
InLettere = InLettere + "cento"
Else
InLettere = InLettere + Cifra(Frazione3 + 1) + "cento"
End If
End If
If Frazione2 <= 20 Then
InLettere = InLettere + Cifra(Frazione2 + 1)
Else
Temp = Frazione2 / 10
Frazione3 = Int(Temp)
InLettere = InLettere + Cifra(Frazione3 + 19)
Frazione2 = Frazione2 - Frazione3 * 10
If Frazione2 = 1 Or Frazione2 = 8 Then
InLettere = Left(InLettere, Len(InLettere) - 1)
End If
InLettere = InLettere + Cifra(Frazione2 + 1)
End If
Select Case Esp
Case 1
If Frazione1 = 1 Then
InLettere = Left(InLettere, Len(InLettere) - 3) + "mille"
Else
InLettere = InLettere + "mila"
End If
Case 2
If Frazione1 = 1 Then
InLettere = Left(InLettere, Len(InLettere) - 3) + "unmilione"
Else
InLettere = InLettere + "milioni"
End If
Case 3
If Frazione1 = 1 Then
InLettere = Left(InLettere, Len(InLettere) - 3) + "unmiliardo"
Else
InLettere = InLettere + "miliardi"
End If
Case 4
If Frazione1 = 1 Then
InLettere = "mille"
Else
InLettere = InLettere + "mila"
End If
If Int((Numero - Frazione1 * 1000 ^ Esp) / 1000 ^ 3) = 0 Then
Numero = Numero - Frazione1 * 1000 ^ Esp
End If
Next
NumeroInLettere = InLettere
End Function
Gabriele Bertolucci
ha scritto:
Eccolo in allegato.
>Salve. Avrei bisogno dell' algoritmo che converte i numeri in testo (stile
>Ric.Bancarie)
>
>Esempio:
>1560000
>in:
>UNMILIONECINQUECENTOSESSANTAMILA**************
~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~
Gabriele Bertolucci - NT4WKSITA+SP3 - VB5PROITA+SP3
pbe...@vi.ats.it
pbe...@freemail.it (alias)
pbe...@bigfoot.com (alias)
http://members.spree.com/sip/pberto/
http://userspace.ats.it/free/pberto/ (alias)
http://www.fortunecity.com/skyscraper/spiff/523/ (alias)
http://www.bigfoot.com/~pberto/ (alias)
ICQ #: 9732192
~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~