Convierte número a letra, función definida por el usuario de excel




Este es un ejemplo de VBA, precisamente es un procedimiento de Excelfunción que convierte un número a letra, algo que Excel siendo un programa versátil y potente no trae incorporado, también en este otro post se agrega una función que convierte números en letras, el resultado es similar, variando sólo la forma en que escribe los números y centavos, se recomienda ver el  funcionamiento de  los dos  y usar el que mejor se adapte a vuestro vocabulario, la forma de incorporar la función para  que aparezca en el listado de funciones de Excel, precisamente en la sección de fórmulas definidas por el usuario, se encuentra explicado en el video que se encuentra inserto en el post, es bastante fácil realizarlo ya que se encuentra explica en detalle, si tienes alguna duda no dudes en comunicarte para aclarar las mismas.

Te recomiendo que leas un excelente libro sobre Excel el que te ayudará manejar las planillas de cálculo y obtener una gran habilidad para su uso, debes hacer click acá.


Private Function Unidades(num, UNO)
Dim U
Dim Cad
   
    U = Array("un", "dos", "tres", "cuatro", "cinco", "seis", "siete", "ocho", "nueve")
    Cad = ""
    If num = 1 Then
        If UNO = 1 Then
            Cad = Cad & "uno"
        Else
            Cad = Cad & "un"
        End If
    Else
        Cad = Cad & U(num - 1)
    End If
    Unidades = Cad
End Function
Private Function Decenas(num1, res)
Dim D1
    D1 = Array("once", "doce", "trece", "catorce", "quince", "dieciseis", "diecisiete", _
                "dieciocho", "diecinueve")
    D2 = Array("diez", "veint", "treinta", "cuarenta", "cincuenta", "sesenta", _
                "setenta", "ochenta", "noventa")
   
    If num1 > 10 And num1 < 20 Then
        Cad1 = D1(num1 - 10 - 1)
    Else
        Cad1 = D2((num1 \ 10) - 1)
        If (num1 \ 10) <> 2 Then
            If res > 0 Then
                Cad1 = Cad1 & " y "
                Cad1 = Cad1 & Unidades(num1 Mod 10, 0)
            End If
        Else
            If res = 0 Then
                Cad1 = Cad1 & "e"
            Else
                Cad1 = Cad1 & "i"
                Cad1 = Cad1 & Unidades(num1 Mod 10, 0)
            End If
        End If
    End If
    Decenas = Cad1
End Function
Private Function Cientos(num2)
   num3 = num2 \ 100
    Select Case num3
        Case 1
                If num2 = 100 Then
                    cad2 = "cien "
                Else
                    cad2 = "ciento "
                End If
        Case 5
                cad2 = "quinientos "
        Case 7
                cad2 = "setecientos "
        Case 9
                cad2 = "novecientos "
        Case Else
                cad2 = Unidades(num3, 0) & "cientos "
    End Select
   
    num2 = num2 Mod 100
    If num2 > 0 Then
        If num2 < 10 Then
            cad2 = cad2 & Unidades(num2, num2)
        Else
            cad2 = cad2 & Decenas(num2, num2 Mod 10)
        End If
    End If
    Cientos = cad2
End Function
Private Function Miles(num4)
    If (num4 >= 100) Then
        cad3 = Cientos(num4)
    Else






        If (num4 >= 10) Then
            cad3 = Decenas(num4, num4 Mod 10)
        Else
            cad3 = Unidades(num4, 0)
        End If
    End If
    cad3 = cad3 & " mil "
    Miles = cad3
End Function
Private Function Millones(cant)
    If cant = 1 Then
        ter = " "
    Else
        ter = "es "
    End If
    If (cant >= 1000) Then
        cantl = cantl & Miles(cant \ 1000)
        cant = cant Mod 1000
    End If
    If cant > 0 Then
        If cant >= 100 Then
            cantl = cantl & Cientos(cant)
        Else
            If cant >= 10 Then
                cantl = cantl & Decenas(cant, cant Mod 10)
            Else
                cantl = cantl & Unidades(cant, 0)
            End If
        End If
    End If
    Millones = cantl & " millon" & ter
End Function
Private Function decimales(numero As Single) As Integer
Dim iaux As Integer
  iaux = numero - Application.Round(numero, 2)
  decimales = iaux
End Function
Function NumeroLetra(IngreseValor As Variant) As String
  Dim cants1 As String, num1 As Variant, num2 As Variant
 
    num1 = IngreseValor \ 1000000
    num2 = IngreseValor - (num1 * 1000000)
    cents = (num2 * 100) Mod 100
    If cents = 0 Then
        cents1 = "00"
    Else
      cents1 = Format(cents)
    End If
    IngreseValor = IngreseValor - (cents / 100)
    If IngreseValor >= 1000000 Then
        cantlm = Millones(IngreseValor \ 1000000)
        IngreseValor = IngreseValor Mod 1000000
    End If
    If IngreseValor > 0 Then
        If (IngreseValor >= 1000) Then
            cantlm = cantlm & Miles(IngreseValor \ 1000)
            IngreseValor = IngreseValor Mod 1000
        End If
    End If
    If IngreseValor > 0 Then
        If IngreseValor >= 100 Then
            cantlm = cantlm & Cientos(IngreseValor)
        Else
            If IngreseValor >= 10 Then
                cantlm = cantlm & Decenas(IngreseValor, IngreseValor Mod 10)
            Else
                cantlm = cantlm & Unidades(IngreseValor, 1)
            End If
        End If
    End If
   
NumeroLetra = cantlm & " con  " & cents1 & "/100 centavos"
   
End Function


 

Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página.


If this post was helpful INVITE ME A COFFEE and so help keep up the page.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends