Discussione: numeri in lettere
View Single Post
Old 24-03-2005, 17:06   #1
fux_vr
Member
 
Iscritto dal: Mar 2004
Messaggi: 267
numeri in lettere

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 è offline   Rispondi citando il messaggio o parte di esso