¿Hay algún algoritmo para pasar números a texto en Visual Basic?

¿Tienes el algoritmo para traspasar números a texto?, lo necesito con un poco de urgencia, gracias por tu ayuda.
Terramar..

1 respuesta

Respuesta
1
ok, por aca va...
Revísalo y me avisas... lo único que debieras cambiar son los símbolos monetarios para los de tu país..
Option Explicit
Public Const Un_Billon = 1000000000000#
Public Const Dos_Billones = 2000000000000#
Public Function NumeroTexto(Valor As Double) As String
Select Case Valor
Case Is <= 100
NumeroTexto = Menor_Cien(Valor)
Case Is < 2000
NumeroTexto = Menor_DosMil(Valor)
Case Is < 2000000
NumeroTexto = Menor_DosCientosMil(Valor)
Case Is < Dos_Billones
NumeroTexto = Menor_DosBillones(Valor)
Case Else
NumeroTexto = NumeroTexto(Int(Valor / Un_Billon)) & " BILLONES"
If (Valor - Int(Valor / Un_Billon) * Un_Billon) Then
NumeroTexto = NumeroTexto & " " & NumeroTexto(Valor - Int(Valor / Un_Billon) * Un_Billon)
End If
End Select
End Function
Public Function Menor_Cien(Cifra As Double) As String
If Cifra = 0 Then
Menor_Cien = "CERO"
ElseIf Cifra = 1 Then Menor_Cien = "UN"
ElseIf Cifra = 2 Then Menor_Cien = "DOS"
ElseIf Cifra = 3 Then Menor_Cien = "TRES"
ElseIf Cifra = 4 Then Menor_Cien = "CUATRO"
ElseIf Cifra = 5 Then Menor_Cien = "CINCO"
ElseIf Cifra = 6 Then Menor_Cien = "SEIS"
ElseIf Cifra = 7 Then Menor_Cien = "SIETE"
ElseIf Cifra = 8 Then Menor_Cien = "OCHO"
ElseIf Cifra = 9 Then Menor_Cien = "NUEVE"
ElseIf Cifra = 10 Then Menor_Cien = "DIEZ"
ElseIf Cifra = 11 Then Menor_Cien = "ONCE"
ElseIf Cifra = 12 Then Menor_Cien = "DOCE"
ElseIf Cifra = 13 Then Menor_Cien = "TRECE"
ElseIf Cifra = 14 Then Menor_Cien = "CATORCE"
ElseIf Cifra = 15 Then Menor_Cien = "QUINCE"
ElseIf Cifra < 20 Then Menor_Cien = "DIECI" & NumeroTexto(Cifra - 10)
ElseIf Cifra = 20 Then Menor_Cien = "VEINTE"
ElseIf Cifra < 30 Then Menor_Cien = "VEINTI" & NumeroTexto(Cifra - 20)
ElseIf Cifra = 30 Then Menor_Cien = "TREINTA"
ElseIf Cifra = 40 Then Menor_Cien = "CUARENTA"
ElseIf Cifra = 50 Then Menor_Cien = "CINCUENTA"
ElseIf Cifra = 60 Then Menor_Cien = "SESENTA"
ElseIf Cifra = 70 Then Menor_Cien = "SETENTA"
ElseIf Cifra = 80 Then Menor_Cien = "OCHENTA"
ElseIf Cifra = 90 Then Menor_Cien = "NOVENTA"
ElseIf Cifra < 100 Then
Menor_Cien = NumeroTexto(Int(Cifra \ 10) * 10) & " Y " & NumeroTexto(Cifra Mod 10)
ElseIf Cifra = 100 Then Menor_Cien = "CIEN"
End If
End Function
Public Function Menor_DosMil(Cifra As Double) As String
If Cifra < 200 Then
Menor_DosMil = "CIENTO " & NumeroTexto(Cifra - 100)
ElseIf Cifra = 200 Or Cifra = 300 Or Cifra = 400 Or Cifra = 600 Or Cifra = 800 Then
Menor_DosMil = NumeroTexto(Int(Cifra \ 100)) & "CIENTOS"
ElseIf Cifra = 500 Then Menor_DosMil = "QUINIENTOS"
ElseIf Cifra = 700 Then Menor_DosMil = "SETECIENTOS"
ElseIf Cifra = 900 Then Menor_DosMil = "NOVECIENTOS"
ElseIf Cifra < 1000 Then
Menor_DosMil = NumeroTexto(Int(Cifra \ 100) * 100) & " " & NumeroTexto(Cifra Mod 100)
ElseIf Cifra = 1000 Then Menor_DosMil = "MIL"
ElseIf Cifra < 2000 Then Menor_DosMil = "MIL " & NumeroTexto(Cifra Mod 1000)
End If
End Function
Public Function Menor_DosCientosMil(Cifra As Double) As String
If Cifra < 1000000 Then
Menor_DosCientosMil = NumeroTexto(Int(Cifra \ 1000)) & " MIL"
If Cifra Mod 1000 Then
Menor_DosCientosMil = Menor_DosCientosMil & " " & NumeroTexto(Cifra Mod 1000)
End If
ElseIf Cifra = 1000000 Then Menor_DosCientosMil = "UN MILLON"
ElseIf Cifra < 2000000 Then Menor_DosCientosMil = "UN MILLON " & NumeroTexto(Cifra Mod 1000000)
End If
End Function
Public Function Menor_DosBillones(Cifra As Double) As String
If Cifra < Un_Billon Then
Menor_DosBillones = NumeroTexto(Int(Cifra / 1000000)) & " MILLONES"
If (Cifra - Int(Cifra / 1000000) * 1000000) Then
Menor_DosBillones = Menor_DosBillones & " " & NumeroTexto(Cifra - Int(Cifra / 1000000) * 1000000)
End If
ElseIf Cifra = Un_Billon Then Menor_DosBillones = "UN BILLON"
ElseIf Cifra < Dos_Billones Then
Menor_DosBillones = "UN BILLON " & NumeroTexto(Cifra - Int(Cifra / Un_Billon) * Un_Billon)
End If
End Function
Public Function Recibo(Cifra As Double, Moneda As String) As String
Dim Centimos As Double
Recibo = NumeroTexto(Int(Cifra))
If Int(Cifra) = 1 Then
If Moneda = "EUR" Then
Recibo = Recibo & " EURO"
ElseIf Moneda = "PTA" Then
Recibo = Recibo & " A PESOS"
End If
Else
If Moneda = "EUR" Then
Recibo = Recibo & " EUROS"
ElseIf Moneda = "PTA" Then
Recibo = Recibo & " PESOS"
End If
End If
If Moneda = "PTA" Then
'If InStr(1, Cifra, ",") < 0 Then
Centimos = CDbl(CLng((Cifra - Int(Cifra)) * 100))
'Recibo = Recibo & " " & NumeroTexto(Centimos)
If Centimos = 0 Then
Recibo = Recibo & " " & "00"
Else
Recibo = Recibo & " " & Centimos
End If
If Centimos = 1 Then
Recibo = Recibo & "/100 M.N."
Else
Recibo = Recibo & "/100 M.N."
End If
End If
'End If
End Function
Sub calcular_Euro()
ActiveCell.Value = Recibo(ActiveCell.Value, "EUR")
End Sub
Sub calcular_Pesos()
ActiveCell.Value = Recibo(ActiveCell.Value, "PTA")
End Sub
Un abrazo desde Chile.
Master

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas