.
El Codigo es Expansible... de forma muy facil.
El siguiente codigo me costo un Ojo de la cara... es para convertir cualquier Numero a Texto Plano. lo hice por Hobby mas que por nesesidad, espero le saquen provecho!¡.
Como maximo mumero que puede leer son es: 999999999999999999999999999999
Novecientos noventa y nueve Octillónes novecientos noventa y nueve Sextillónes novecientos noventa y nueve Quintillónes novecientos noventa y nueve Cuatrillónes novecientos noventa y nueve Trillones novecientos noventa y nueve Billones novecientos noventa y nueve Mil novecientos noventa y nueve Millones novecientos noventa y nueve Mil novecientos noventa y nueve Billon 10^12 <--( 5 ).
Trillon 10^18 <--( 4 ).
Cuatrillón 10^24 <--( 3 ).
Quintillón 10^30 <--( 2 ).
Sextillón 10^36 <--( 1 ).
Octillón 10^42 <--( 0 ).
<--Obviamente Los siguientes numeros no los tomaremos en cuenta-->
Gúgol 10^100 <--(-1 ).
Googolplex 10^10^Gúgol <--(-2 ).
http://infrangelux.sytes.net/Blog/index.php?option=com_content&view=article&id=8:arrtnum2string&catid=2:catprocmanager&Itemid=8'
' /////////////////////////////////////////////////////////////
' // 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 //
' /////////////////////////////////////////////////////////////
Public Function Number2String(ByVal VInNumber As String) As String
' // Meximo --> 999999999999999999999999999999 ' sección Octillón...
' // Billon 10^12 <--( 5 ).
' // Trillon 10^18 <--( 4 ).
' // Cuatrillón 10^24 <--( 3 ).
' // Quintillón 10^30 <--( 2 ).
' // Sextillón 10^36 <--( 1 ).
' // Octillón 10^42 <--( 0 ).
' // <--Obviamente Los siguientes numeros no los tomaremos en cuenta-->
' // Gúgol 10^100 <--(-1 ).
' // Googolplex 10^10^Gúgol <--(-2 ).
Dim Str_Temp As String
Dim Byt_Index As Byte
Dim Byt_Digito As Byte
Dim Byt_Centena As Byte
Dim Byt_Decena As Byte
Dim Byt_Unidad As Byte
Dim Str_Leyenda As String
Dim lng_LenStr As Long
Const clng_MaxLen = &H1E
lng_LenStr = Len(VInNumber)
If lng_LenStr > clng_MaxLen Or lng_LenStr = 0 Then Exit Function
Str_Temp = String$(clng_MaxLen, "0")
Mid(Str_Temp, clng_MaxLen - lng_LenStr + 1) = Mid$(VInNumber, 1, lng_LenStr)
For Byt_Index = 1 To clng_MaxLen / 3
Byt_Centena = CByte(Mid$(Str_Temp, Byt_Index * 3 - 2, 1))
Byt_Decena = CByte(Mid$(Str_Temp, Byt_Index * 3 - 1, 1))
Byt_Unidad = CByte(Mid$(Str_Temp, Byt_Index * 3, 1))
Select Case Byt_Index
Case 1
If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
Str_Leyenda = "Octillón "
ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
Str_Leyenda = "Octillónes "
End If
Case 2
If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
Str_Leyenda = "Sextillón "
ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
Str_Leyenda = "Sextillónes "
End If
Case 3
If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
Str_Leyenda = "Quintillón "
ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
Str_Leyenda = "Quintillónes "
End If
Case 4
If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
Str_Leyenda = "Cuatrillón "
ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
Str_Leyenda = "Cuatrillónes "
End If
Case 5
If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
Str_Leyenda = "Trillon "
ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
Str_Leyenda = "Trillones "
End If
Case 6
If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
Str_Leyenda = "Billón "
ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
Str_Leyenda = "Billones "
End If
Case 7
If Byt_Centena + Byt_Decena + Byt_Unidad >= 1 And Val(Mid$(Str_Temp, 21, 3)) = 0 Then
Str_Leyenda = "Mil Millones "
ElseIf Byt_Centena + Byt_Decena + Byt_Unidad >= 1 Then
Str_Leyenda = "Mil "
End If
Case 8
If Byt_Centena + Byt_Decena = 0 And Byt_Unidad = 1 Then
Str_Leyenda = "Millón "
ElseIf Byt_Centena > 0 Or Byt_Decena > 0 Or Byt_Unidad > 1 Then
Str_Leyenda = "Millones "
End If
Case 9
If Byt_Centena + Byt_Decena + Byt_Unidad >= 1 Then Str_Leyenda = "Mil "
Case 10
If Byt_Centena + Byt_Decena + Byt_Unidad >= 1 Then Str_Leyenda = ""
End Select
Number2String = Number2String + Centena(Byt_Unidad, Byt_Decena, Byt_Centena) + Decena(Byt_Unidad, Byt_Decena) + Unidad(Byt_Unidad, Byt_Decena) + Str_Leyenda
Str_Leyenda = ""
Next
End Function
Private Function Centena(ByVal Byt_Uni As Byte, ByVal Byt_Decimal As Byte, ByVal Byt_Centena As Byte) As String
Select Case Byt_Centena
Case 1: If Byt_Decimal + Byt_Uni = 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 Byt_Uni As Byte, ByVal Byt_Decimal As Byte) As String
Select Case Byt_Decimal
Case 1
Select Case Byt_Uni
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 Byt_Uni = 0 Then
Decena = "veinte "
ElseIf Byt_Uni > 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 Byt_Uni > 0 And Byt_Decimal > 2 Then Decena = Decena + "y "
End Function
Private Function Unidad(ByVal Byt_Uni As Byte, ByVal Byt_Decimal As Byte) As String
If Byt_Decimal <> 1 Then
Select Case Byt_Uni
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 Byt_Uni
Case 6: Unidad = "seis "
Case 7: Unidad = "siete "
Case 8: Unidad = "ocho "
Case 9: Unidad = "nueve "
End Select
End Function
Dulce Infierno Lunar!¡.
