Newsgroup: it.comp.lang.visual-basic
Titolo: [CERCO] Algoritmo di conversione NUM > LETTERE

Salve. Avrei bisogno dell' algoritmo che converte i numeri in testo (stile
Ric.Bancarie)
Esempio:
1560000
in:
UNMILIONECINQUECENTOSESSANTAMILA**************
Grazie.
Fabio Guerrazzi

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.

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
+==========================+

Grazie Luca, l'algoritmo č utile e serve anche a me. Mi hai fatto risparmiare
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

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...


------------
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


Anch'io avrei bisogno dell'algoritmo (non di esempi o ocx)
Grazie
Zeus

...

Zeus, se ti serve l'algoritmo per poi usarlo in Borland Pascal 7, cerca su
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

Ric.Bancarie)


 


 


Questa è una'altra versione abbastanza elegante


 


Public 
Function NumeroInLettere(ByVal Numero As Currency) As String
If Numero = 0 
Then Exit Function


 


Dim 
Frazione1 As Integer
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"


 


For Esp = 
4 To 0 Step -1
    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 



                    
InLettere = InLettere + "miliardi"


                

endif


            End 
Select
            
Numero = Numero - Frazione1 * 1000 ^ 
Esp
        End If
    
Next
    NumeroInLettere = InLettere
End 
Function


 



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
~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~#~