Autor
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!¡.
En línea
