PDA

View Full Version : numeri in lettere


fux_vr
24-03-2005, 16:06
in un data base di access ho dei numeri e li devo traformare in lettere ho trovato cremo un modulo cosi'
perche non mi funziona?? cosa devo metter nel modulo??
che mod devo fare?



Public Function NumLettere(n As Double) As String
Dim resto As Double
Dim centinaia As Double
Dim Ordine As Integer
Dim StrN As String
Dim Decina As String
Dim cestr As String
Dim migliaia As String
Dim restomilioni As Double
Dim numfin As Double
Dim restomiliardi As Double
Dim miliardi As String
NumLettere = ""
'modifica apportata il 28/3/00
If n = 0 And fatto = False Then NumLettere = "zero": Exit Function
fatto = True
If n < 20 Then NumLettere = Unità(n): Exit Function
StrN = Trim(Str(n))
Ordine = Len(Trim(Str(n)))
'unità
numfin = CDbl(Right(StrN, 2))
If numfin <= 19 Then
NumLettere = NumLettere(numfin)
Else
NumLettere = NumLettere(CDbl(Right(StrN, 1)))
'decine
StrN = Trim(Str(n - CDbl(Right(StrN, 1))))
Decina = Decine(CDbl(Right(StrN, 2)) / 10)
If (NumLettere = "uno" Or NumLettere = "otto") And Decina <> "" Then Decina = Left(Decina, Len(Decina) - 1)
'If NumLettere = "otto" And Decina <> "" Then Decina = Left(Decina, Len(Decina) - 1)
NumLettere = Decina & NumLettere
End If
centinaia = (CDbl(StrN) - CDbl(Right(StrN, 2))) / 100
If centinaia = 0 Then Exit Function
If centinaia <= 9 Then
If centinaia > 1 Then
cestr = NumLettere(centinaia) & Esp(2)
Else
cestr = Esp(2)
End If
Else
resto = Left(Trim(Str(centinaia)), Len(Trim(Str(centinaia))) - 1)
centinaia = Right(Trim(Str(centinaia)), 1)

'if centinaia =0 then
If centinaia > 1 Then cestr = NumLettere(centinaia) & Esp(2)
If centinaia = 1 Then cestr = Esp(2)
If resto <= 999 And resto > 0 Then
If resto = 1 Then
migliaia = Esp(3)
Else
migliaia = Left(NumLettere(resto) & Esp(3), Len(NumLettere(resto) & Esp(3)) - 2) & "a"
End If
Else
restomilioni = CDbl(Left(Trim(Str(resto)), Len(Trim(Str(resto))) - 3))
If restomilioni = 1 Then
milioni = "un" & Esp(6)
'aggiunta del 28/03
migliaia = NumLettere(CDbl(Right(Trim(Str(resto)), Len(Trim(Str(resto))) - 1))) & "mila"

Else
If restomilioni <= 999 And restomilioni > 0 Then
milioni = NumLettere(restomilioni) & "milioni"
Else
restomiliardi = CDbl(Left(Trim(Str(restomilioni)), Len(Trim(Str(restomilioni))) - 3))
End If
If restomiliardi = 1 Then
miliardi = "un" & Esp(9)
'aggiunta del 28/03/00
restomilioni = CDbl(Right(Trim(Str(restomilioni)), 3))
If restomilioni = 1 Then
milioni = "un" & Esp(6)
Else
If restomilioni <= 999 And restomilioni > 0 Then milioni = NumLettere(restomilioni) & "milioni"
End If
Else
If restomiliardi > 0 Then
miliardi = NumLettere(restomiliardi) & "miliardi"
restomilioni = CDbl(Right(Trim(Str(restomilioni)), 3))
If restomilioni = 1 Then
milioni = "un" & Esp(6)
Else
If restomilioni <= 999 And restomilioni > 0 Then milioni = NumLettere(restomilioni) & "milioni"
End If
End If
End If
' If restomilioni <> 0 Then milioni = Left(NumLettere(restomilioni) & Esp(6), Len(NumLettere(restomilioni) & Esp(6)) - 2) & "a"
'migliaia = NumLettere(CDbl(Right(Trim(Str(resto)), 3))) & Esp(3)
resto = CDbl(Right(Trim(Str(resto)), 3))
If resto <> 0 Then migliaia = Left(NumLettere(resto) & Esp(3), Len(NumLettere(resto) & Esp(3)) - 2) & "a"
End If

End If
End If
'cestr = Esp(((CDbl(StrN) - CDbl(Right(StrN, 2))) / 100) + 1)
'End If
If migliaia = "mila" Then migliaia = ""
NumLettere = miliardi & milioni & migliaia & cestr & NumLettere
End Function
Public Function NumeroCaso(inf As Double, sup As Double) As Double
Randomize
NumeroCaso = Int(((sup) * Rnd) + inf) ' Genera un valore casuale
' compreso tra 1 e numerotracce-1.
End Function
Public Function eliminadoppie(strnum As String) As String
Dim i As Integer
Dim lettera1 As String * 1
Dim lettera2 As String * 1
For i = 1 To (Len(strnum) - 1)
lettera1 = Right(Left(strnum, i), 1)
lettera2 = Right(Left(strnum, i + 1), 1)
'If lettera1 = lettera2 And (lettera1 = "a" Or lettera1 = "o" Or lettera1 = "e" Or lettera1 = "i" Or lettera1 = "u") Then strnum = Left(strnum, i) & Right(strnum, Len(strnum) - i - 1)
'If (lettera1 = "a" Or lettera1 = "o" Or lettera1 = "e" Or lettera1 = "i" Or lettera1 = "u") And (lettera2 = "a" Or lettera2 = "o" Or lettera2 = "e" Or lettera2 = "i" Or lettera2 = "u") Then strnum = Left(strnum, i - 1) & Right(strnum, Len(strnum) - i): eliminadoppie = eliminadoppie(strnum): Exit Function
If (lettera1 = "a" Or lettera1 = "o" Or lettera1 = "e" Or lettera1 = "i" Or lettera1 = "u") And (lettera2 = lettera1) Then strnum = Left(strnum, i - 1) & Right(strnum, Len(strnum) - i): eliminadoppie = eliminadoppie(strnum): Exit Function

Next i
eliminadoppie = strnum
If Len(strnum) > 4 And InStr(1, strnum, "zero") <> 0 Then
strnum = Left(strnum, Len(strnum) - 4)
eliminadoppie = strnum
End If
End Function

fux_vr
24-03-2005, 17:58
risolto