[Src] numberToName (Correcion al codigo anterior).

.
Es una correccion al codigo anterior por que contenia HORRORES...

desde el 1 al 999999999999999999999999999999999999999999999999999999999999999999

Ejemplo:

Código

 
Private Sub Form_Load()
    MsgBox numberToName(InputBox("Ingresa un numero cualquiera", "numberToName", "87984516512"))
End Sub

OutPut (Test Number: 87984516512):

Citar

ochenta y siete mil novecientos ochenta y cuatro millones quinientos dieci seis mil quinientos doce

Código

 
'
'   /////////////////////////////////////////////////////////////
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandecido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////
'   // http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=8:arrtnum2string&catid=2:catprocmanager&Itemid=3
'   /////////////////////////////////////////////////////////////
 
Option Explicit
 
Public Function numberToName(ByVal sNumber As String) As String
'   //  MAXIMO  --> 999999999999999999999999999999999999999999999999999999999999999999 ' sección Decillones...
 
'   //  Millon          1 * 10^6
'   //  Billon          1 * 10^12
'   //  Trillon         1 * 10^18
'   //  Cuatrillón      1 * 10^24
'   //  Quintillón      1 * 10^30
'   //  Sextillón       1 * 10^36
'   //  Sptillon        1 * 10^42
'   //  Octillón        1 * 10^48
'   //  Sextillón       1 * 10^54
'   //  Octillón        1 * 10^60
'   //  <--Son bastantes numeros... como para seguirle no creen?-->
 
Dim i           As Long
Dim lLn         As Long
Dim sTmp        As String
Dim bCentena    As Byte
Dim bDecena     As Byte
Dim bUnidad     As Byte
Const MAXLEN    As Long = &H42
 
    lLn = Len(sNumber)
    If (lLn > MAXLEN) Or (lLn = 0) Then Exit Function
 
    sTmp = String$(MAXLEN, "0")
 
    Mid$(sTmp, MAXLEN - lLn + 1) = Mid$(sNumber, 1, lLn)
 
    For i = 1 To MAXLEN Step 3
 
        bCentena = CByte(Mid$(sTmp, i, 1))
        bDecena = CByte(Mid$(sTmp, i + 1, 1))
        bUnidad = CByte(Mid$(sTmp, i + 2, 1))
 
        numberToName = numberToName & centena(bUnidad, bDecena, bCentena) & _
                                      decena(bUnidad, bDecena) & _
                                      unidad(bUnidad, bDecena) & _
                                      IIf(Not (i = (MAXLEN - &H2)), getLeyenda(sNumber, i, bUnidad, bDecena, bCentena), "")
    Next
 
End Function
 
Private Function getLeyenda(ByRef sTmp As String, ByVal i As Long, ByVal bUnidad As Byte, ByVal bDecena As Byte, ByVal bCentena As Byte) As String
'   //  Se obtiene la leyenda con referencia a la ESCALA CORTA.
 
    Select Case i
        Case &H4
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "decillon "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "decillones "
            End If
 
        Case &HA
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "nonillon "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "nonillones "
            End If
 
        Case &H10
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "octillón "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "octillónes "
            End If
 
        Case &H16
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "septillon "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "septillones "
            End If
 
        Case &H1C
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "sextillón "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "sextillónes "
            End If
 
        Case &H22
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "quintillón "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "quintillónes "
            End If
 
        Case &H28
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "cuatrillón "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "cuatrillónes "
            End If
 
        Case &H2E
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "trillon "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "trillones "
            End If
 
        Case &H34
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "billón "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "billones "
            End If
 
        Case &H3A
            If ((bCentena + bDecena) = 0) And (bUnidad = 1) Then
                getLeyenda = "millón "
            ElseIf ((bCentena + bDecena + bUnidad) > 1) Then
                getLeyenda = "millones "
            End If
 
        Case Else
            If ((bCentena + bDecena + bUnidad) > 1) Then getLeyenda = "mil "
 
    End Select
 
End Function
 
Private Function centena(ByVal bUnidad As Byte, ByVal bDecena As Byte, ByVal bCentena As Byte) As String
    Select Case bCentena
        Case 1: If (bDecena + bUnidad) = 0 Then centena = "cien " Else centena = "ciento "
        Case 2: centena = "doscientos "
        Case 3: centena = "trescientos "
        Case 4: centena = "cuatrocientos "
        Case 5: centena = "quinientos "
        Case 6: centena = "seiscientos "
        Case 7: centena = "setecientos "
        Case 8: centena = "ochocientos "
        Case 9: centena = "novecientos "
    End Select
End Function
 
Private Function decena(ByVal bUnidad As Byte, ByVal bDecena As Byte) As String
    Select Case bDecena
        Case 1
            Select Case bUnidad
                Case 0: decena = "diez "
                Case 1: decena = "once "
                Case 2: decena = "doce "
                Case 3: decena = "trece "
                Case 4: decena = "catorce "
                Case 5: decena = "quince "
                Case 6 To 9: decena = "dieci "
            End Select
        Case 2
            If bUnidad = 0 Then
                decena = "veinte "
            ElseIf bUnidad > 0 Then
                decena = "veinti "
            End If
        Case 3: decena = "treinta "
        Case 4: decena = "cuarenta "
        Case 5: decena = "cincuenta "
        Case 6: decena = "sesenta "
        Case 7: decena = "setenta "
        Case 8: decena = "ochenta "
        Case 9: decena = "noventa "
    End Select
    If bUnidad > 0 And bDecena > 2 Then decena = decena + "y "
End Function
 
Private Function unidad(ByVal bUnidad As Byte, ByVal bDecena As Byte) As String
    If bDecena <> 1 Then
        Select Case bUnidad
            Case 1: unidad = "un "
            Case 2: unidad = "dos "
            Case 3: unidad = "tres "
            Case 4: unidad = "cuatro "
            Case 5: unidad = "cinco "
        End Select
    End If
    Select Case bUnidad
            Case 6: unidad = "seis "
            Case 7: unidad = "siete "
            Case 8: unidad = "ocho "
            Case 9: unidad = "nueve "
    End Select
End Function

Temibles Lunas!¡.