NumerosALetras

Macros que Convierte los numeros a Letras

Espero les sea util, lo encontre navegando por la web hace mucho tiempo el cual lo modifique a pesos M.N.

Pasos para que esta macro funcione:
1. Abrir un nuevo libro en Excel

2.- Dar Click en el Editor de Visual Basic del Menu Programador
2. Insertar un módulo.
3. Pegar el siguiente código:

'Ejemplo:  Macros que convierte tus importe de pesos a letras

Function NumLetras(Valor As Currency, Optional MonedaSingular As String = "", Optional MonedaPlural As String = "M.N.)") As String
Dim Cantidad As Currency, Centavos As Currency, Digito As Byte, PrimerDigito As Byte, SegundoDigito As Byte, TercerDigito As Byte, Bloque As String, NumeroBloques As Byte, BloqueCero
Dim Unidades As Variant, Decenas As Variant, Centenas As Variant, I As Variant
Dim ValorEntero As Long
Dim ValorOriginal As Double

    Valor = Round(Valor, 2)
    Cantidad = Int(Valor)
    ValorEntero = Cantidad
    Centavos = (Valor - Cantidad) * 100
    Unidades = Array("Un", "Dos", "Tres", "Cuatro", "Cinco", "Seis", "Siete", "Ocho", "Nueve", "Diez", "Once", "Doce", "Trece", "Catorce", "Quince", "Dieciseis", "Diecisiete", "Dieciocho", "Diecinueve", "Veinte", "Veintiun", "Veintidos", "Veintitres", "Veinticuatro", "Veinticinco", "Veintiseis", "Veintisiete", "Veintiocho", "Veintinueve")
    Decenas = Array("Diez", "Veinte", "Treinta", "Cuarenta", "Cincuenta", "Sesenta", "Setenta", "Ochenta", "Noventa")
    Centenas = Array("Ciento", "Doscientos", "Trescientos", "Cuatrocientos", "Quinientos", "Seiscientos", "Setecientos", "Ochocientos", "Novecientos")
    NumeroBloques = 1
    
    Do
        PrimerDigito = 0
        SegundoDigito = 0
        TercerDigito = 0
        Bloque = ""
        BloqueCero = 0
        For I = 1 To 3
            Digito = Cantidad Mod 10
            If Digito <> 0 Then
                Select Case I
                Case 1
                    Bloque = " " & Unidades(Digito - 1)
                    PrimerDigito = Digito
                Case 2
                    If Digito <= 2 Then
                        Bloque = " " & Unidades((Digito * 10) + PrimerDigito - 1)
                    Else
                        Bloque = " " & Decenas(Digito - 1) & IIf(PrimerDigito <> 0, " Y", Null) & Bloque
                    End If
                    SegundoDigito = Digito
                Case 3
                    Bloque = " " & IIf(Digito = 1 And PrimerDigito = 0 And SegundoDigito = 0, "Cien", Centenas(Digito - 1)) & Bloque
                    TercerDigito = Digito
                End Select
            Else
                BloqueCero = BloqueCero + 1
            End If
            Cantidad = Int(Cantidad / 10)
            If Cantidad = 0 Then
                Exit For
            End If
        Next I
        Select Case NumeroBloques
            Case 1
                NumLetras = Bloque
            Case 2
                NumLetras = Bloque & IIf(BloqueCero = 3, Null, " Mil") & NumLetras
            Case 3
                NumLetras = Bloque & IIf(PrimerDigito = 1 And SegundoDigito = 0 And TercerDigito = 0, " Millon", " Millones") & NumLetras
        End Select
        NumeroBloques = NumeroBloques + 1
    Loop Until Cantidad = 0
    
    
    If Valor >= 1000000000 Then
        Dim millardos As Currency
        Dim millarodsInt As Integer
        Dim letras_Millardos As String
        millarodsInt = Int(Valor / 1000000000)
        millardos = millarodsInt
        
        letras_Millardos = Replace(Trim(NumLetras(millardos)), "Pesos " & "00/100", IIf(millarodsInt = 1, "Mil Millones", "Mil Millones"))
        NumLetras = letras_Millardos & NumLetras

    End If
    
    NumLetras = "Son: ( " & Trim(NumLetras) & " " & "Pesos " & Format(Str(Centavos), "00") & "/100 " & IIf(ValorEntero = 1, MonedaSingular, MonedaPlural)
End Function