> ... alguna libreria que cambie los numeros a letras ,,, textbaht() ... arroja un resultado en tailandes [...]
[si lees mas adelante en la ayuda] la funcion TextoBaht 'solo sirve' para el idioma Tailandes :((
checate el siguiente enlace: http://tinyurl.com/5njo9
saludos,
hector.
Option Explicit
Const UNI = 1, DIECI = 2, DECENA = 3, CENTENA = 4
Function Numalet(strnuM As String) As String
'Mariano Alejandro Hernández 11/2003
Dim nuM As Double
Dim teR As Integer
Dim i As Integer
Dim numcaD As String
Dim matriZcaD(0 To 9, UNI To CENTENA) As String
Dim caDternA As String, resultadO As String
Dim centenAternA As Integer, decenAternA As Integer, unidaDternA As Integer
Dim NumeroDeternA As Byte
If IsNumeric(strnuM) Then
nuM = CDbl(Abs(strnuM))
Else
Numalet = "#¡VALOR!"
Exit Function
End If
If nuM >= 1000000000000# Or nuM < 0 Then
Numalet = "#¡NUM!"
Exit Function
End If
If nuM < 1 Then resultadO = " cero"
Call llenaConCadenas(matriZcaD)
numcaD = CStr(Fix(Format(nuM, "standard")))
NumeroDeternA = 0
i = Len(numcaD)
Do 'Procesa el número desde atras hacia adelante en ternas
NumeroDeternA = NumeroDeternA + 1
caDternA = "" 'Inicializa la cadena de la terna
If i >= 3 Then ' Extrae la terna
teR = Val(Mid(numcaD, i - 2, 3))
Else
teR = Val(Mid(numcaD, 1, i)) 'Cuando ya no hay una terna
End If
centenAternA = Int(teR / 100) 'centenA
decenAternA = teR - Int(teR / 100) * 100 'decena y unidad
unidaDternA = decenAternA - Int(decenAternA / 10) * 10 'solo unidad
Select Case decenAternA 'Procesa decenas y unidades
Case 1 To 9
caDternA = matriZcaD(unidaDternA, UNI) & caDternA
Case 10 To 19
caDternA = caDternA & matriZcaD(decenAternA - (Int(decenAternA /
10) * 10), DIECI)
Case 20
caDternA = caDternA & " veinte"
Case 21 To 29
caDternA = caDternA & matriZcaD(Int(decenAternA / 10), DECENA) _
& Mid(matriZcaD(unidaDternA, UNI), 2, Len(matriZcaD(unidaDternA,
UNI)) - 1)
Case 30 To 99
If unidaDternA <> 0 Then
caDternA = matriZcaD(Int(decenAternA / 10), DECENA) _
& " y" & matriZcaD(unidaDternA, UNI) & caDternA
Else
caDternA = caDternA & matriZcaD(Int(decenAternA / 10),
DECENA)
End If
End Select
Select Case centenAternA 'Procesa las centenas
Case 1
If decenAternA > 0 Then
caDternA = " ciento" & caDternA
Else
caDternA = " cien" & caDternA
End If
Case 5, 7, 9
caDternA = matriZcaD(Int(teR / 100), CENTENA) & caDternA
Case Else
If Int(teR / 100) > 1 Then caDternA = matriZcaD _
(Int(teR / 100), UNI) & "cientos" & caDternA
End Select
If unidaDternA = 1 And NumeroDeternA > 1 And decenAternA <> 11 Then _
caDternA = Mid(caDternA, 1, Len(caDternA) - 1)
Select Case NumeroDeternA 'Según el número de terna agrega la
unidad
Case 3
If nuM < 2000000 Then 'para que no aparezca "mil millón", sino "mil
millones"
caDternA = caDternA & " millón"
Else
caDternA = caDternA & " millones"
End If
Case 2, 4
If teR > 0 Then caDternA = caDternA & " mil"
End Select
resultadO = caDternA & resultadO
i = i - 3
Loop While i > 0 'hasta que se acaben las ternas
Numalet = UCase(Mid(resultadO, 2, 1)) & Mid(resultadO, 3, Len(resultadO)) &
" con " & Round((nuM - Int(nuM)), 2) * 100 & "/100.-"
End Function
Sub llenaConCadenas(matriZ)
matriZ(1, UNI) = " uno"
matriZ(2, UNI) = " dos"
matriZ(3, UNI) = " tres"
matriZ(4, UNI) = " cuatro"
matriZ(5, UNI) = " cinco"
matriZ(6, UNI) = " seis"
matriZ(7, UNI) = " siete"
matriZ(8, UNI) = " ocho"
matriZ(9, UNI) = " nueve"
matriZ(0, DIECI) = " diez"
matriZ(1, DIECI) = " once"
matriZ(2, DIECI) = " doce"
matriZ(3, DIECI) = " trece"
matriZ(4, DIECI) = " catorce"
matriZ(5, DIECI) = " quince"
matriZ(6, DIECI) = " dieciseis"
matriZ(7, DIECI) = " diecisiete"
matriZ(8, DIECI) = " dieciocho"
matriZ(9, DIECI) = " diecinueve"
matriZ(2, DECENA) = " veinti"
matriZ(3, DECENA) = " treinta"
matriZ(4, DECENA) = " cuarenta"
matriZ(5, DECENA) = " cincuenta"
matriZ(6, DECENA) = " sesenta"
matriZ(7, DECENA) = " setenta"
matriZ(8, DECENA) = " ochenta"
matriZ(9, DECENA) = " noventa"
matriZ(5, CENTENA) = " quinientos"
matriZ(7, CENTENA) = " setecientos"
matriZ(9, CENTENA) = " novecientos"
End Sub
Saludos
--
Mariano A. Hernández
"PATRICK PALMA" <PATRICK PA...@discussions.microsoft.com> escribió en el
mensaje news:D616B441-6639-4FA3...@microsoft.com...
> Alguien sabe de alguna libreria que cambie los numeros a letras
> existe una funcion que se llama textbaht(), pero arroja un resultado en
> tailandes, y eso no se entiende.
> Gracias, si pueden responden al email: ppa...@devida.gob.pe