[Src] numberToName (Correcion al codigo anterior).

[BlackZeroX]

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

desde el 1 al 999999999999999999999999999999999999999999999999999999999999999999

Ejemplo:

Código (vb) [Seleccionar] Expandir



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



OutPut (Test Number: 87984516512):

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

Código (Vb) [Seleccionar] Expandir



'
'   /////////////////////////////////////////////////////////////
'   // 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!¡.

[CAR3S?]

buen aporte!!! x)