Newsgroup: it.comp.appl.access
Titolo: Funzione per convertire numeri in testo es: 100 -> CENTO

Alcuni giorni fa mi sembra di avere visto la richiesta di una simile
funzione...
come al solito al netto di miglioramenti sempre possibili
(anzi sono graditi i commenti e le osservazioni) ecco la mia soluzione:
Public Function DiconsiLire(Numero As Variant) As String
    Dim Unità(10) As String * 7
    Dim Decina(10) As String * 11
    Dim Decine(10) As String * 9
    Dim Migliaia(5) As String * 8
    Dim Tipo As Integer
    Dim Virgola As Integer
    Dim Decimale As Long
    Dim Gruppi As Integer
    Dim Gruppo As String * 3
    Dim Mask As String
    Dim x%, y%, z%
    Dim Letterale As String
    Dim Terzina As String
    Dim Digit As String * 1
    Dim NumTesto As String
    Const Uno = "UNO"
    Const Cento = "CENTO"
    Const Mille = "MILLE"
    Const UnMilione = "UNMILIONE"
    Const UnMiliardo = "UNMILIARDO"
    Const Vocali = "AEIOU"
    Unità(0) = "       ": Decina(0) = "DIECI      ": Decine(0) = "         "
    Unità(1) = "UNO    ": Decina(1) = "UNDICI     ": Decine(1) = "DIECI    "
    Unità(2) = "DUE    ": Decina(2) = "DODICI     ": Decine(2) = "VENTI    "
    Unità(3) = "TRE    ": Decina(3) = "TREDICI    ": Decine(3) = "TRENTA   "
    Unità(4) = "QUATTRO": Decina(4) = "QUATTORDICI": Decine(4) = "QUARANTA "
    Unità(5) = "CINQUE ": Decina(5) = "QUINDICI   ": Decine(5) = "CINQUANTA"
    Unità(6) = "SEI    ": Decina(6) = "SEDICI     ": Decine(6) = "SESSANTA "
    Unità(7) = "SETTE  ": Decina(7) = "DICIASSETTE": Decine(7) = "SETTANTA "
    Unità(8) = "OTTO   ": Decina(8) = "DICIOTTO   ": Decine(8) = "OTTANTA  "
    Unità(9) = "NOVE   ": Decina(9) = "DICIANNOVE ": Decine(9) = "NOVANTA  "
    Migliaia(5) = "MILIONI "
    Migliaia(4) = "MILA    "
    Migliaia(3) = "MILIARDI"
    Migliaia(2) = "MILIONI "
    Migliaia(1) = "MILA"
    Migliaia(0) = ""
    Tipo = VarType(Numero) 'Recupera il tipo di variabile
                           'sono convertibili i tipi da
                           'vbInteger a vbCurrency
    If Tipo < vbInteger And Tipo > vbCurrency Then
        MsgBox "Valore non Convertibile", _
               vbExclamation + vbOKOnly, _
               "Messaggio all'Utente"
        DiconsiLire = ""
        Exit Function
    End If
    Letterale = Trim(Format(Numero, "####.##"))
    'Estrazione della parte decimale
    Virgola = InStr(1, Letterale, ",", vbTextCompare)
    Decimale = Val(Mid(Letterale, Virgola + 1, Len(Letterale) - Virgola))
    Letterale = Left(Letterale, Virgola - 1)
    'Quanti gruppi di tre cifre vi sono ?
    Gruppi = Len(Letterale) / 3 + IIf(Len(Letterale) Mod 3, 1, 0)
    Mask = String(Gruppi * 3, "0")
    Letterale = Format(Val(Letterale), Mask)
    For x = 0 To Gruppi - 1
        Gruppo = Mid(Letterale, 1 + 3 * x, 3)
        Terzina = ""
        'Primo digit della terzina
        Digit = Left(Gruppo, 1)
        If Digit <> "1" Then
            Terzina = Trim(Unità(Val(Digit))) & IIf(Digit <> "0", Cento, "")
        Else
            Terzina = Cento
        End If
        'Secondo digit della terzina se il caso è 11, 12, ... anche il terzo
        Digit = Mid(Gruppo, 2, 1)
        If InStr(1, Vocali, Right(Terzina, 1)) <> 0 And _
           InStr(1, Vocali, Left(Unità(Val(Digit)), 1)) And _
           Len(Terzina) > 1 Then
            Terzina = Left(Terzina, Len(Terzina) - 1)
        End If
        If Digit <> "1" Then
            Terzina = Terzina & IIf(Digit <> "0", Trim(Decine(Digit)), "")
        Else
            Digit = Mid(Gruppo, 3, 1)
            Terzina = Terzina & Trim(Decina(Digit))
            GoTo Avanza
        End If
        'Terzo digit della terzina
        Digit = Mid(Gruppo, 3, 1)
        If InStr(1, Vocali, Right(Terzina, 1)) <> 0 And _
           InStr(1, Vocali, Left(Unità(Val(Digit)), 1)) And _
           Len(Terzina) > 1 Then
            Terzina = Left(Terzina, Len(Terzina) - 1)
        End If
        If Len(Terzina) = 0 And Digit = "1" Then
            Terzina = Uno
        Else
            Terzina = Terzina & Trim(Unità(Val(Digit)))
        End If
Avanza:
    Terzina = Terzina & Trim(Migliaia(Gruppi - 1 - x))
    If Terzina = Trim(Migliaia(Gruppi - 1 - x)) Then Terzina = ""
    If Terzina = "UNOMILA" Then Terzina = Mille
    If Terzina = "UNOMILIONI" Then Terzina = UnMilione
    If Terzina = "UNOMILIARDI" Then Terzina = UnMiliardo
    NumTesto = NumTesto & Terzina
    Next x
    DiconsiLire = NumTesto & " , " & Decimale
End Function
Saluti a tutti...
Dario

 wrote in message
8aoaqs$mqh$1...@fe1.cs.interbusiness.it...

Bravo,
ma sul sito comune c'era gia'. Potevi scaricarla da li'.
Ciao, Sib
--
------------------------------------------------------
il sito comune di it.comp.database.access:
http://members.xoom.it/it_db_access
------------------------------------------------------
4000 anni fa', il saggio egizio Ptahhotep scrisse:
"... perche' non esistono saggi per nascita."
------------------------------------------------------
Saturiamo ECHELON:
bomba saddam attentato medio oriente

>ma sul sito comune c'era gia'. Potevi scaricarla da li'.
sib, non quotare 160 righe di messaggio per aggiungerne un paio...
--
il sito comune di it.comp.appl.access:
http://members.xoom.it/it_db_access/

 
http://members.xoom.it/it_db_access/
Pardon.
Sib