Newsgroup: it.comp.appl.access
Titolo: Converti numeri in lettere

Salve a tutti!
Ho bisogno di aiuto!
C'è qualcuno che ha una procedura per convertire le cifre (soprattutto
valuta) in lettere? Vi prego, ne ho un bisogno disperato!
Grazie di nuovo!

 ha scritto nel messaggio
news:9k67n4$lpt$1...@serv1.albacom.net...



Copia questa funzione in un modulo nuovo e salvalo. Poniamo che tu abbia un
campo numerico in una tabella chiamato Campo1, per avere il valore in
lettere (ad esempio in una query,  una maschera o un report) basta che tu
scriva:
Num2Lett ([campo1])
Ciao, Arturo
'---------------------------------------------------------------------------
------
Function Num2Lett(par As Variant) As String
         Dim Buf As String, RetVal As String, i  As Integer, cifra
         Static Unita(10)  As String, c As Integer, tmp As String
         Static Decine(1 To 10)  As String, n As Integer, pos As Integer
         Static dieci(10 To 19)
         On Error Resume Next
         Unita(0) = "ZERO"
         Unita(1) = "UNO"
         Unita(2) = "DUE"
         Unita(3) = "TRE"
         Unita(4) = "QUATTRO"
         Unita(5) = "CINQUE"
         Unita(6) = "SEI"
         Unita(7) = "SETTE"
         Unita(8) = "OTTO"
         Unita(9) = "NOVE"
         Unita(10) = "DIECI"
         Decine(1) = "DIECI"
         Decine(2) = "VENTI"
         Decine(3) = "TRENTA"
         Decine(4) = "QUARANTA"
         Decine(5) = "CINQUANTA"
         Decine(6) = "SESSANTA"
         Decine(7) = "SETTANTA"
         Decine(8) = "OTTANTA"
         Decine(9) = "NOVANTA"
         Decine(10) = "CENTO"
         dieci(11) = "UNDICI"
         dieci(12) = "DODICI"
         dieci(13) = "TREDICI"
         dieci(14) = "QUATTORDICI"
         dieci(15) = "QUINDICI"
         dieci(16) = "SEDICI"
         dieci(17) = "DICIASSETTE"
         dieci(18) = "DICIOTTO"
         dieci(19) = "DICIANNOVE"
         Const MILLE = "MILLE"
         Const MIL = "MILIONE"
         Const MILS = "MILIONI"
         Const MILA = "MILA"
         Buf = Trim$(Str$(Int(par)))
         i = Len(Buf)
         cifra = 0
         RetVal = " "
         pos = 0
         tmp = ""
         While i >= 1
               tmp = Mid$(Buf, i, 1) & tmp
               i = i - 1
               If Len(tmp) = 3 Then
                  GoTo CnvNum
Ret:
                     If Left$(RetVal, 7) = "UNOMILA" Then
                        RetVal = "MILLE" + Mid$(RetVal, 8, Len(RetVal) - 8)
                     End If
                     If Left$(RetVal, 10) = "UNOMILIONI" Then
                        RetVal = "UNMILIONE" + Mid$(RetVal, 11,
Len(RetVal) - 11)
                     End If
                  tmp = ""
               End If
         Wend
         If Len(tmp) < 3 Then
            GoTo CnvNum99
Ret99:
         End If
         Num2Lett = RetVal
         Exit Function
CnvNum:
  pos = pos + 1
  'If tmp = "000" And pos = 1 Then
   'Retval = "MILA" & Retval
  ' GoTo Ret:
  'End If
  If Right$(tmp, 2) = "00" And pos = 2 And tmp <> "000" Then
     RetVal = "MILA" & RetVal
  End If
  If Right$(tmp, 2) = "00" And pos = 3 And tmp <> "000" Then
     RetVal = "MILIONI" & RetVal
  End If
  n = Val(Right$(tmp, 2))
  If n < 20 Then
     If pos = 2 And n > 10 Then
        RetVal = dieci(n) & "MILA" & RetVal
     ElseIf pos = 3 And n > 10 Then
        RetVal = dieci(n) & "MILIONI" & RetVal
     ElseIf n > 10 Then
        RetVal = dieci(n) & RetVal
     ElseIf n <= 10 And n > 0 Then
        If pos = 2 Then
           RetVal = Unita(n) & "MILA" & RetVal
        ElseIf pos = 3 Then
           RetVal = Unita(n) & "MILIONI" & RetVal
        Else
           RetVal = Unita(n) & RetVal
        End If
     End If
     n = Val(Left$(tmp, 1))
     If n = 1 Then
        RetVal = "CENTO" & RetVal
     End If
     If n > 1 Then
        RetVal = Unita(n) & "CENTO" & RetVal
     End If
     GoTo Ret:
  End If
     If pos = 2 Then
        RetVal = "MILA" & RetVal
     ElseIf pos = 3 Then
        RetVal = "MILIONI" & RetVal
     End If
  n = Val(Mid$(tmp, 3, 1))
  If n > 0 Then
   RetVal = Unita(n) & RetVal
  End If
  n = Val(Mid$(tmp, 2, 1))
  RetVal = Decine(n) & RetVal
  n = Val(Mid$(tmp, 1, 1))
  If n = 1 Then
     RetVal = "CENTO" & RetVal
  End If
  If n > 1 Then
     RetVal = Unita(n) & "CENTO" & RetVal
  End If
GoTo Ret:
CnvNum99:
  pos = pos + 1
  n = Val(tmp)
  If n < 20 Then
     If pos = 2 And n > 0 Then
        If n > 10 Then
           RetVal = dieci(n) & "MILA" & RetVal
        Else
           RetVal = Unita(n) & "MILA" & RetVal
        End If
     ElseIf pos = 3 And n > 0 Then
        If n > 10 Then
           RetVal = dieci(n) & "MILIONI" & RetVal
        Else
           RetVal = Unita(n) & "MILIONI" & RetVal
        End If
     ElseIf n > 0 Then
        RetVal = dieci(n) & RetVal
     End If
     GoTo Ret99:
  End If
     If pos = 2 Then
        RetVal = "MILA" & RetVal
     ElseIf pos = 3 Then
        RetVal = "MILIONI" & RetVal
     End If
  n = Val(Right$(tmp, 1))
  If n > 0 Then
     RetVal = Unita(n) & RetVal
  End If
  n = Val(Left$(tmp, 1))
  If n > 1 Then
     RetVal = Decine(n) & RetVal
  End If
     GoTo Ret99:
End Function

Grazie mille!
Non so veramente come ringraziarti per il codice!
Grazie di nuovo!

 Grazie di nuovo!
De nada.
Arturo