transform a number into letter Catalonian language only. Visual Basic Code.
Option Explicit
Dim cadenita As Variant
Public Function En_letra_cat(VALOR As Variant, Optional xyz As Variant) As String
If IsNull(VALOR) Then Exit Function
'estructura de la numeracion:
'millares MIL //centenas//decenas//milions milions // centenas // decenas //millares MIL // centenas//decenas//unidades EUROS
'con //decenas//unidades CENTIMOS DE EUROS
Dim coma As Integer
Dim cadena1 As String
Dim cadena2 As String
Dim cadena_m As String
Dim n_caracteres As Integer
Dim euro As String
Dim longitud As Integer
Dim x As Integer
Dim a As Integer
Dim NuncaNegativoSiemprePositivo As Boolean ' by ex-entrenador del Barsa
' Vamos a meternos con los negativos
NuncaNegativoSiemprePositivo = False
If Len(Trim((VALOR))) > 0 Then
Else
En_letra_cat = ""
Exit Function
End If
If Val(VALOR) < 0 Then
En_letra_cat = "!!!!!! ERROR: NUMERO NEGATIVO ¡¡¡¡¡¡¡¡¡¡"
Exit Function
End If
VALOR = comprueba(CStr(VALOR))
If Len(CStr(VALOR)) > 15 Then
MsgBox "Too Many digits in the String ! ! "
Exit Function
End If
longitud = Len(CStr(VALOR))
coma = InStr(VALOR, ",")
If longitud > 12 Then
longitud = longitud - 3 'saco la len menos los decimales
longitud = longitud - 9 'saco la len menos la cadena1
cadena1 = CStr(CLng(Mid(VALOR, longitud + 1, 9)))
cadena_m = CStr(CLng(Left(VALOR, longitud)))
cadena2 = Right(VALOR, 2)
x = 3
Else
cadena1 = CStr(CLng((Left(VALOR, coma - 1))))
cadena2 = Mid(VALOR, coma + 1)
x = 2
End If
'Euro o Euros
If Len(cadena1) > 1 Then
euro = " Euros "
Else
If cadena1 = 1 Then
euro = " Euro "
Else
euro = " Euros "
End If
End If
'empezamos con cadena1, en funcion de la longitud, llamamos a una función u a otra
For a = 1 To x
If a = 1 Then
n_caracteres = Len(cadena1)
Select Case n_caracteres
Case 1
If cadena1 = 0 Then
cadena1 = "zero"
Else
cadena1 = unidad(CInt(cadena1))
End If
Case 2
cadena1 = decenas(CInt(cadena1))
Case 3
cadena1 = centenas(CInt(cadena1))
Case 4
If Left(cadena1, 1) = 1 Then
cadena1 = " mil " & centenas(Right(cadena1, 3))
Else
cadena1 = unidad(Left(cadena1, 1)) & " mil " & centenas(Right(cadena1, 3))
End If
Case 5
cadena1 = decenas(Left(cadena1, 2)) & " mil " & centenas(Right(cadena1, 3))
Case 6
cadena1 = centenas(Left(cadena1, 3)) & " mil " & centenas(Right(cadena1, 3))
Case 7
If Left(cadena1, 1) = 1 Then
cadena1 = "un milió " & IIf((centenas(Mid(cadena1, 2, 3)) = ""), "", centenas(Mid(cadena1, 2, 3)) & " mil ") & centenas(Right(cadena1, 3))
Else
cadena1 = unidad(Left(cadena1, 1)) & " milions " & centenas(Mid(cadena1, 2, 3)) & " mil " & centenas(Right(cadena1, 3))
End If
Case 8
cadena1 = decenas(Left(cadena1, 2)) & " milions " & centenas(Mid(cadena1, 3, 4)) & " mil " & centenas(Right(cadena1, 3))
Case 9
cadena1 = centenas(Left(cadena1, 3)) & " milions " & centenas(Mid(cadena1, 4, 3)) & " mil " & centenas(Right(cadena1, 3))
End Select
End If
If a = 2 Then
'empezamos con cadena 2, los decimales
n_caracteres = Len((cadena2))
Select Case n_caracteres
Case 1
cadena2 = cadena2 & 0
cadena2 = decenas(CInt(cadena2))
Case 2
cadena2 = decenas(CInt(cadena2))
End Select
If x = 2 Then
Select Case cadena2
Case "un"
En_letra_cat = UCase(cadena1 & euro & "amb " & cadena2 & " centim.")
Case ""
En_letra_cat = UCase(cadena1 & euro)
Case Else
En_letra_cat = UCase(cadena1 & euro & "amb " & cadena2 & " centims.")
End Select
End If
End If
If a = 3 Then
n_caracteres = Len(cadena_m)
Select Case n_caracteres
Case 1
cadena_m = unidad(CInt(cadena_m))
Case 2
cadena_m = decenas(CInt(cadena_m))
Case 3
cadena_m = centenas(CInt(cadena_m))
Case 4
If Left(cadena_m, 1) = 1 Then
cadena_m = " mil " & centenas(Right(cadena_m, 3))
Else
cadena_m = unidad(Left(cadena_m, 1)) & " mil " & centenas(Right(cadena_m, 3))
End If
Case 5
cadena_m = decenas(Left(cadena_m, 2)) & " mil " & centenas(Right(cadena_m, 3))
Case 6
cadena_m = centenas(Left(cadena_m, 3)) & " mil " & centenas(Right(cadena_m, 3))
Case 7
If Left(cadena_m, 1) = 1 Then
cadena_m = "un milió " & centenas(Mid(cadena_m, 2, 3)) & " mil " & centenas(Right(cadena_m, 3))
Else
cadena_m = unidad(Left(cadena_m, 1)) & " milions " & centenas(Mid(cadena_m, 2, 3)) & " mil " & centenas(Right(cadena_m, 3))
End If
Case 8
cadena_m = decenas(Left(cadena_m, 2)) & " milions " & centenas(Mid(cadena_m, 3, 4)) & " mil " & centenas(Right(cadena_m, 3))
Case 9
cadena_m = centenas(Left(cadena_m, 3)) & " milions " & centenas(Mid(cadena_m, 4, 3)) & " mil " & centenas(Right(cadena_m, 3))
End Select
If x = 3 Then
If cadena2 = "" Then
En_letra_cat = UCase(cadena_m & " mil " & cadena1 & euro)
Else
If cadena2 = "un" Then
En_letra_cat = UCase(cadena_m & " mil " & cadena1 & euro & "con " & cadena2 & " centimo.")
Else
En_letra_cat = UCase(cadena_m & " mil " & cadena1 & euro & "con " & cadena2 & " centimos.")
End If
End If
End If
End If
Next a
End Function
Private Function unidad(VALOR As Integer) As String
Select Case VALOR
Case 1
unidad = "un"
Case 2
unidad = "dos"
Case 3
unidad = "tres"
Case 4
unidad = "quatre"
Case 5
unidad = "cinc"
Case 6
unidad = "sis"
Case 7
unidad = "set"
Case 8
unidad = "vuit"
Case 9
unidad = "nou"
Case 0
unidad = ""
End Select
End Function
Private Function decenas(VALOR As Integer)
'tenemos que distinguir entre once... doce... y los demás como siempre
Dim pepe
'si la longitud es un caracter, entonces llamamos a UNIDAD
If Len(CStr(VALOR)) = 1 Then
decenas = unidad(VALOR)
Exit Function
End If
'cojemos el primer dígito
pepe = Left(CStr(VALOR), 1)
Select Case pepe
Case 1
Select Case VALOR
Case 10
decenas = "deu"
Case 11
decenas = "onze"
Case 12
decenas = "dotze"
Case 13
decenas = "tretze"
Case 14
decenas = "catorze"
Case 15
decenas = "quinze"
Case 16
decenas = "setze"
Case 17
decenas = "diset"
Case 18
decenas = "divuit"
Case 19
decenas = "dinou"
End Select
Case 9
If Right(CStr(VALOR), 1) = 0 Then
decenas = "noranta"
Else
decenas = "noranta-" & unidad(CInt(Right(CStr(VALOR), 1)))
End If
Case Else
Select Case pepe
Case 2
If Right(CStr(VALOR), 1) = 0 Then
decenas = "vint"
Else
decenas = "vint-i-" & unidad(Right(VALOR, 1))
End If
Case 3
If Right(CStr(VALOR), 1) = 0 Then
decenas = "trenta"
Else
decenas = "trenta-" & unidad(Right(VALOR, 1))
End If
Case 4
If Right(CStr(VALOR), 1) = 0 Then
decenas = "quaranta"
Else
decenas = "quaranta-" & unidad(Right(VALOR, 1))
End If
Case 5
If Right(CStr(VALOR), 1) = 0 Then
decenas = "cincuanta"
Else
decenas = "cincuanta-" & unidad(Right(VALOR, 1))
End If
Case 6
If Right(CStr(VALOR), 1) = 0 Then
decenas = "seixanta"
Else
decenas = "seixanta-" & unidad(Right(VALOR, 1))
End If
Case 7
If Right(CStr(VALOR), 1) = 0 Then
decenas = "setanta"
Else
decenas = "setanta-" & unidad(Right(VALOR, 1))
End If
Case 8
If Right(CStr(VALOR), 1) = 0 Then
decenas = "vuitanta"
Else
decenas = "vuitanta-" & unidad(Right(VALOR, 1))
End If
Case 0
decenas = "" & unidad(Right(VALOR, 1))
End Select
End Select
End Function
Private Function centenas(VALOR As Variant) As String
'si la cifra es de longitud uno, llamo a UNIDADES
If Len(CStr(CInt(VALOR))) = 1 Then
centenas = unidad(CInt(VALOR))
Exit Function
End If
'si la cifra es de longitud 2, llamo a DECENAS
If Len(CStr(CInt(VALOR))) = 2 Then
centenas = decenas(CInt(VALOR))
Exit Function
End If
Dim pepe As Integer
VALOR = CStr(CInt(VALOR))
pepe = Left(VALOR, 1)
Select Case pepe
Case 1
If VALOR = "100" Then
centenas = "cent"
Else
centenas = "cent " & decenas(Mid(VALOR, 2))
End If
Case 2
centenas = "dos-cents " & decenas(Mid(VALOR, 2))
Case 3
centenas = "tres-cents " & decenas(Mid(VALOR, 2))
Case 4
centenas = "quatre-cents " & decenas(Mid(VALOR, 2))
Case 5
centenas = "cinc-cents " & decenas(Mid(VALOR, 2))
Case 6
centenas = "sis-cents " & decenas(Mid(VALOR, 2))
Case 7
centenas = "set-cents " & decenas(Mid(VALOR, 2))
Case 8
centenas = "vuit-cents " & decenas(Mid(VALOR, 2))
Case 9
centenas = "nou-cents " & decenas(Mid(VALOR, 2))
End Select
End Function
Private Function comprueba(VALOR As String) As String
Dim coma As Integer
Dim cadena2 As String
coma = InStr(VALOR, ",")
'si no hay coma entonces le pongo dos ceros decimales
If coma = 0 Then
VALOR = VALOR & ",00"
End If
'recupero coma
coma = InStr(VALOR, ",")
'meto los decimales en cadena2
cadena2 = Mid(CStr(VALOR), coma + 1)
'si la len de cadena2=1 entonces le pongo un 0 al final
If Len(CStr(cadena2)) = 1 Then
VALOR = VALOR & 0
End If
comprueba = VALOR
End Function
Add to favourites
Subscribe comments
Copy code
Mail user
Add to friends