> Teneis hecha alguna rutina que traduzca cifras en pesetas:
> 10000 --> diezmil pesetas
> 13285 --> Trecemil Doscientas Ochenta y Cinco pesetas

Esta rutina hace lo que pides. Es de la página del Guille y tienes que pegarla en un módulo:
Aprovecho también para desearos un feliz año.


'-----------------------------------------------------------------
' 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()
    If unidad(1) <> "una" Then
        '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) = "doscientas"
        centena(3) = "trescientas"
        centena(4) = "cuatrocientas"
        centena(5) = "quinientas"
        centena(6) = "seiscientas"
        centena(7) = "setecientas"
        centena(8) = "ochocientas"
        centena(9) = "novecientas"
        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 If
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" <esteve@mur.hnet.es> (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
    '
    InicializarArrays

    '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



Saludos
Sergio
scardenas@bigfoot.com

Posh Power !!!!
***********++++++++***********
Naked
Nothing but a smile upon her face
Naked
She wants to play seek and hide, no one to hide behind
Naked
This child has fallen from grace
Naked
Don't be afraid to stare she is only naked
(Naked - Spice Girls)
***********++++++++***********
[I've got PGP / Tengo PGP]
ICQ: 6369154

Content-Type: text/plain;
    charset="iso-8859-1"

X-MIME-Autoconverted: from 8bit to quoted-printable by amadeus.spin.com.mx id JAA19285


-----Original Message-----
De: Jose Angel Mateo <ventecnic@redestb.es>
Para: Foro Visual Basic Rediris <vb-esp@ccc.uba.ar>
Fecha: Miércoles 7 de Enero de 1998 3:45 AM
Asunto: (VB-ESP) Rutina para traducir cifras



    Hola a todos,

    Teneis hecha alguna rutina que traduzca cifras en pesetas:
        10000 --> diezmil pesetas
        13285 --> Trecemil Doscientas Ochenta y Cinco pesetas
        ....


Tengo una rutina que lo traduce a Pesos Mexicanos B-), sin embargo no creo
que sea mayor problema (cambiar las unidades monetarias y ya) adaptarlo a
tus necesidades. Es una función que se llama Num2Let y está en VB3. Te envío
el fuente por este medio.

+¡Saludos desde México!+
| |
| .+'~~'+. |
| * Tron * David.BAS |
| `+,__,+' |
| |
+-adgarza@spin.com.mx--+

 num2letv.mak   num2letv.frx   num2letv.frm