PASE DE NUMEROS A LETRAS

19/07/2005 - 01:18 por Fernando | Informe spam
Hola:
Hace muchos años conseguí un archivo de Lotus, por el cual, cargando una
cifra en una celda, la misma se expresaba en letras en otra previamente
indicada.
Alguien tendrá un archivo que me permita realizar esa tarea?.
El archivo que usaba se llamaba "Monto".
Muchas gracias.
 

Leer las respuestas

#1 hector barajas
20/07/2005 - 02:41 | Informe spam
Este codigo alguna vez lo consegui. Escribe los argumentos mas o menos asi
Numero2Letra(I38,,"pesos","centavos")

y copia este codigo en un modulo

'--
' gsNumero.BAS Módulo para procedimientos numéricos ( 1/Mar/91)
' Versión para Windows (25/Oct/96)
'
' Última revisión: (10/Jul/97)
'
'(c)Guillermo Som, 1991-97
'--
Option Explicit
Option Compare Text

'Declaradas a nivel de módulo
Dim unidad(0 To 9) As String
Dim decena(0 To 9) As String
Dim centena(0 To 10) As String
Dim deci(0 To 9) As String
Dim otros(0 To 15) As String

Private Sub InicializarArrays()

'Asignar los valores
unidad(1) = "una"
unidad(2) = "dos"
unidad(3) = "tres"
unidad(4) = "cuatro"
unidad(5) = "cinco"
unidad(6) = "seis"
unidad(7) = "siete"
unidad(8) = "ocho"
unidad(9) = "nueve"
'
decena(1) = "diez"
decena(2) = "veinte"
decena(3) = "treinta"
decena(4) = "cuarenta"
decena(5) = "cincuenta"
decena(6) = "sesenta"
decena(7) = "setenta"
decena(8) = "ochenta"
decena(9) = "noventa"
'
centena(1) = "ciento"
centena(2) = "doscientos"
centena(3) = "trescientos"
centena(4) = "cuatrocientos"
centena(5) = "quinientos"
centena(6) = "seiscientos"
centena(7) = "setecientos"
centena(8) = "ochocientos"
centena(9) = "novecientos"
centena(10) = "cien" 'Parche
'
deci(1) = "dieci"
deci(2) = "veinti"
deci(3) = "treinta y "
deci(4) = "cuarenta y "
deci(5) = "cincuenta y "
deci(6) = "sesenta y "
deci(7) = "setenta y "
deci(8) = "ochenta y "
deci(9) = "noventa y "
'
otros(1) = "1"
otros(2) = "2"
otros(3) = "3"
otros(4) = "4"
otros(5) = "5"
otros(6) = "6"
otros(7) = "7"
otros(8) = "8"
otros(9) = "9"
otros(10) = "10"
otros(11) = "once"
otros(12) = "doce"
otros(13) = "trece"
otros(14) = "catorce"
otros(15) = "quince"

End Sub



Public Function Numero2Letra(ByVal strNum As String, Optional ByVal vLo,
Optional ByVal vMoneda, Optional ByVal vCentimos) As String
'-
' Convierte el número strNum en letras (28/Feb/91)
' Versión para Windows (25/Oct/96)
' Variables estáticas (15/May/97)
' Parche de "Esteve" (20/May/97)
' Revisión para decimales (10/Jul/97)
'-

Dim i As Integer
Dim Lo As Integer
Dim iHayDecimal As Integer 'Posición del signo decimal
Dim sDecimal As String 'Signo decimal a usar
Dim sEntero As String
Dim sFraccion As String
Dim fFraccion As Single
Dim sNumero As String
'
Dim sMoneda As String
Dim sCentimos As String

'Si se especifica, se usarán
If Not IsMissing(vMoneda) Then
sMoneda = " " & Trim$(vMoneda) & " "
Else
sMoneda = " "
End If
If Not IsMissing(vCentimos) Then
sCentimos = " " & Trim$(vCentimos)
End If
'Averiguar el signo decimal
sNumero = Format$(25.5, "#.#")
If InStr(sNumero, ".") Then
sDecimal = "."
Else
sDecimal = ","
End If
'Si no se especifica el ancho...
If IsMissing(vLo) Then
Lo = 0
Else
Lo = vLo
End If
'
If Lo Then
sNumero = Space$(Lo)
Else
sNumero = ""
End If
'Quitar los espacios que haya por medio

Do
i = InStr(strNum, " ")
If i = 0 Then Exit Do
strNum = Left$(strNum, i - 1) & Mid$(strNum, i + 1)
Loop

'Comprobar si tiene decimales
iHayDecimal = InStr(strNum, sDecimal)
If iHayDecimal Then
sEntero = Left$(strNum, iHayDecimal - 1)
sFraccion = Mid$(strNum, iHayDecimal + 1) & "00"
'obligar a que tenga dos cifras
sFraccion = Left$(sFraccion, 2)
fFraccion = Val(sFraccion)

'Si no hay decimales... no agregar nada...
If fFraccion < 1 Then
strNum = RTrim$(UnNumero(sEntero) & sMoneda)
If Lo Then
LSet sNumero = strNum
Else
sNumero = strNum
End If
Numero2Letra = sNumero
Exit Function
End If

sEntero = UnNumero(sEntero)
sFraccion = UnNumero(sFraccion)
'
strNum = sEntero & sMoneda & "con " & sFraccion & sCentimos
If Lo Then
LSet sNumero = RTrim$(strNum)
Else
sNumero = RTrim$(strNum)
End If
Numero2Letra = sNumero
Else
strNum = RTrim$(UnNumero(strNum) & sMoneda)
If Lo Then
LSet sNumero = strNum
Else
sNumero = strNum
End If
Numero2Letra = sNumero
End If
End Function

Private Function UnNumero(ByVal strNum As String) As String
'-
'Esta es la rutina principal (10/Jul/97)
'Está separada para poder actuar con decimales
'-

Dim lngA As Double
Dim Negativo As Boolean
Dim L As Integer
Dim Una As Boolean
Dim Millon As Boolean
Dim Millones As Boolean
Dim vez As Integer
Dim MaxVez As Integer
Dim k As Integer
Dim strQ As String
Dim strB As String
Dim strU As String
Dim strD As String
Dim strC As String
Dim iA As Integer
'
Dim strN() As String

'Si se amplia este valor... no se manipularán bien los números
Const cAncho = 12
Const cGrupos = cAncho \ 3
'
If unidad(1) <> "una" Then
InicializarArrays
End If

'Si se produce un error que se pare el mundo!!!
On Local Error GoTo 0

lngA = Abs(CDbl(strNum))
Negativo = (lngA <> CDbl(strNum))
strNum = LTrim$(RTrim$(Str$(lngA)))
L = Len(strNum)

If lngA < 1 Then
UnNumero = "cero"
Exit Function
End If
'
Una = True
Millon = False
Millones = False
If L < 4 Then Una = False
If lngA > 999999 Then Millon = True
If lngA > 1999999 Then Millones = True
strB = ""
strQ = strNum
vez = 0

ReDim strN(1 To cGrupos)
strQ = Right$(String$(cAncho, "0") & strNum, cAncho)
For k = Len(strQ) To 1 Step -3
vez = vez + 1
strN(vez) = Mid$(strQ, k - 2, 3)
Next
MaxVez = cGrupos
For k = cGrupos To 1 Step -1
If strN(k) = "000" Then
MaxVez = MaxVez - 1
Else
Exit For
End If
Next
For vez = 1 To MaxVez
strU = "": strD = "": strC = ""
strNum = strN(vez)
L = Len(strNum)
k = Val(Right$(strNum, 2))
If Right$(strNum, 1) = "0" Then
k = k \ 10
strD = decena(k)
ElseIf k > 10 And k < 16 Then
k = Val(Mid$(strNum, L - 1, 2))
strD = otros(k)
Else
strU = unidad(Val(Right$(strNum, 1)))
If L - 1 > 0 Then
k = Val(Mid$(strNum, L - 1, 1))
strD = deci(k)
End If
End If
'Parche de Esteve
If L - 2 > 0 Then
k = Val(Mid$(strNum, L - 2, 1))
'Con esto funcionará bien el 100100, por ejemplo...
If k = 1 Then 'Parche
If Val(strNum) = 100 Then 'Parche
k = 10 'Parche
End If 'Parche
End If
strC = centena(k) & " "
End If
'
If strU = "uno" And Left$(strB, 4) = " mil" Then strU = ""
strB = strC & strD & strU & " " & strB

If (vez = 1 Or vez = 3) Then
If strN(vez + 1) <> "000" Then strB = " mil " & strB
End If
If vez = 2 And Millon Then
If Millones Then
strB = " millones " & strB
Else
strB = "un millón " & strB
End If
End If
Next
strB = Trim$(strB)
If Right$(strB, 3) = "uno" Then strB = Left$(strB, Len(strB) - 1) & "a"
Do 'Quitar los espacios que haya por medio
iA = InStr(strB, " ")
If iA = 0 Then Exit Do
strB = Left$(strB, iA - 1) & Mid$(strB, iA + 1)
Loop
If Left$(strB, 6) = "una un" Then strB = Mid$(strB, 5)
If Left$(strB, 7) = "una mil" Then strB = Mid$(strB, 5)
If Right$(strB, 16) <> "millones mil una" Then
iA = InStr(strB, "millones mil una")
If iA Then strB = Left$(strB, iA + 8) & Mid$(strB, iA + 13)
End If
If Right$(strB, 6) = "ciento" Then strB = Left$(strB, Len(strB) - 2)
If Negativo Then strB = "menos " & strB

UnNumero = Trim$(strB)
End Function








"Fernando" escribió en el mensaje
news:ekRaI8%
Hola:
Hace muchos años conseguí un archivo de Lotus, por el cual, cargando una
cifra en una celda, la misma se expresaba en letras en otra previamente
indicada.
Alguien tendrá un archivo que me permita realizar esa tarea?.
El archivo que usaba se llamaba "Monto".
Muchas gracias.


Preguntas similares