RE:Convertir numeros en letras
Publicado por
Elsy (1 intervención) el 21/03/2009 17:44:48
Aqui te mando una macro espero te sirva
espero que sepas crear macros
Option Explicit
Dim cTexto As String 'Variable para las funciones
Private Sub Conversion()
Dim Cantidad As String
Dim Respuesta As Integer
Dim NumTmp As String
Dim c01 As Integer
Dim c02 As Integer
Dim pos As Integer
Dim dig As Integer
Dim cen As Integer
Dim dec As Integer
Dim uni As Integer
Dim letra1 As String
Dim letra2 As String
Dim letra3 As String
Dim Leyenda As String
Dim Leyenda1 As String
Dim TFNumero As String
Cantidad = InputBox("Introduzca la cantidad que desea cambiar", "Conversion
de numero a texto")
If Cantidad = "" Then Exit Sub 'Si se presiona cancelar sale del
procedimiento
Cantidad = Validar_Datos(Cantidad) 'Checa que sea un numero
If Cantidad <> "" Then 'Si es diferente de cadena vacia
NumTmp = Format(Cantidad, "000000000000000.00") 'Le da un formato fijo
c01 = 1
pos = 1
TFNumero = ""
'Para extraer tres digitos cada vez
Do While c01 <= 5
c02 = 1
Do While c02 <= 3
'Extrae un digito cada vez de izquierda a derecha
dig = Val(Mid(NumTmp, pos, 1))
If c02 = 1 Then
cen = dig
ElseIf c02 = 2 Then
dec = dig
ElseIf c02 = 3 Then
uni = dig
End If
c02 = c02 + 1
pos = pos + 1
Loop
letra3 = Centena(uni, dec, cen)
letra2 = Decenas(uni, dec, cen)
letra1 = Unidades(uni, dec, cen)
If c01 = 1 Then
If cen + dec + uni = 1 Then
Leyenda = "Billon "
ElseIf cen + dec + uni > 1 Then
Leyenda = "Billones "
End If
ElseIf c01 = 2 Then
If cen + dec + uni >= 1 And Val(Mid(NumTmp, 7, 3)) = 0 Then
Leyenda = "Mil Millones "
ElseIf cen + dec + uni >= 1 Then
Leyenda = "Mil "
End If
ElseIf c01 = 3 Then
If cen + dec = 0 And uni = 1 Then 'Para 1,###,##0.00
Leyenda = "Millon "
ElseIf cen = 0 And dec + uni = 1 Then 'Para 10,###,##0.00
Leyenda = "Millones "
ElseIf cen = 1 And dec + uni = 0 Then 'Para 100,###,##0.00
Leyenda = "Millones "
ElseIf cen + dec + uni > 1 Then 'Para 1##,###,##0.00
Leyenda = "Millones "
End If
ElseIf c01 = 4 Then
If cen + dec + uni >= 1 Then
Leyenda = "Mil "
End If
ElseIf c01 = 5 Then
If cen + dec + uni >= 1 Then
Leyenda = ""
End If
End If
c01 = c01 + 1
TFNumero = TFNumero + letra3 + letra2 + letra1 + Leyenda
Leyenda = ""
letra1 = ""
letra2 = ""
letra3 = ""
Loop
If Val(NumTmp) = 0 Or Val(NumTmp) < 1 Then
Leyenda1 = "Cero Pesos "
ElseIf Val(NumTmp) = 1 Or Val(NumTmp) < 2 Then
Leyenda1 = "Peso "
ElseIf Val(Mid(NumTmp, 4, 12)) = 0 Or Val(Mid(NumTmp, 10, 6)) = 0 Then
Leyenda1 = "de Pesos "
Else
Leyenda1 = "Pesos "
End If
TFNumero = "(" & TFNumero & Leyenda1 & Mid(NumTmp, 17) & "/100 M.N.)"
'Si se desea en mayusculas
Respuesta = MsgBox("Desea el texto en mayusculas", vbYesNo)
If Respuesta = vbYes Then
TFNumero = UCase(TFNumero)
Else
TFNumero = TFNumero
End If
Respuesta = MsgBox("Desea que aparesca la cantidad al frente", vbYesNo)
If Respuesta = vbYes Then
Selection.TypeText Text:=Format(NumTmp, "$ #,##0.00 ") & TFNumero
Else
Selection.TypeText Text:=TFNumero
End If
Else
End If
End Sub
Function Validar_Datos(ByVal Numero As String) As String
Dim Respuesta As Integer
If IsNumeric(Numero) Then 'Verifica que se un numero
If Numero < 0 Then 'Si es numero negativo nos avisa
Respuesta = MsgBox("Se requiere un número positivo. Desea continuar?",
vbYesNo, "Numero Negativo")
If Respuesta = vbYes Then
Validar_Datos = Format(Abs(Numero)) 'Le quita el signo
Else
Validar_Datos = ""
End If
Else
Validar_Datos = Numero 'Si es numero mantiene el valor
End If
Else
MsgBox "Se requiere un número" 'Si no es numero nos avisa y retorna una
cadena vacia
Validar_Datos = ""
End If
End Function
Function Centena(ByVal uni As Integer, ByVal dec As Integer, ByVal cen As
Integer) As String
If cen = 1 And (dec = 0 And uni = 0) Then
cTexto = "Cien "
ElseIf cen = 1 And (dec > 0 Or uni > 0) Then
cTexto = "Ciento "
ElseIf cen = 2 Then
cTexto = "Doscientos "
ElseIf cen = 3 Then
cTexto = "Trescientos "
ElseIf cen = 4 Then
cTexto = "Cuatrocientos "
ElseIf cen = 5 Then
cTexto = "Quinientos "
ElseIf cen = 6 Then
cTexto = "Seiscientos "
ElseIf cen = 7 Then
cTexto = "Setecientos "
ElseIf cen = 8 Then
cTexto = "Ochocientos "
ElseIf cen = 9 Then
cTexto = "Novecientos "
Else
cTexto = ""
End If
Centena = cTexto
cTexto = ""
End Function
Function Decenas(ByVal uni As Integer, ByVal dec As Integer, ByVal cen As
Integer) As String
If dec = 1 And uni = 0 Then
cTexto = "Diez "
ElseIf dec = 1 And uni = 1 Then
cTexto = "Once "
ElseIf dec = 1 And uni = 2 Then
cTexto = "Doce "
ElseIf dec = 1 And uni = 3 Then
cTexto = "Trece "
ElseIf dec = 1 And uni = 4 Then
cTexto = "Catorce "
ElseIf dec = 1 And uni = 5 Then
cTexto = "Quince "
ElseIf dec = 1 And (uni > 5 Or uni < 10) Then
cTexto = "Dieci"
ElseIf dec = 2 And uni = 0 Then
cTexto = "Veinte "
ElseIf dec = 2 And uni > 0 Then
cTexto = "Veinti"
ElseIf dec = 3 Then
cTexto = "Treinta "
ElseIf dec = 4 Then
cTexto = "Cuarenta "
ElseIf dec = 5 Then
cTexto = "Cincuenta "
ElseIf dec = 6 Then
cTexto = "Sesenta "
ElseIf dec = 7 Then
cTexto = "Setenta "
ElseIf dec = 8 Then
cTexto = "Ochenta "
ElseIf dec = 9 Then
cTexto = "Noventa "
Else
cTexto = ""
End If
If uni > 0 And dec > 2 Then
cTexto = cTexto + "y "
End If
Decenas = cTexto
cTexto = ""
End Function
Function Unidades(ByVal uni As Integer, ByVal dec As Integer, ByVal cen As
Integer) As String
If uni = 1 And dec <> 1 Then
cTexto = "Un "
ElseIf uni = 2 And dec <> 1 Then
cTexto = "Dos "
ElseIf uni = 3 And dec <> 1 Then
cTexto = "Tres "
ElseIf uni = 4 And dec <> 1 Then
cTexto = "Cuatro "
ElseIf uni = 5 And dec <> 1 Then
cTexto = "Cinco "
ElseIf uni = 6 Then
cTexto = "Seis "
ElseIf uni = 7 Then
cTexto = "Siete "
ElseIf uni = 8 Then
cTexto = "Ocho "
ElseIf uni = 9 Then
cTexto = "Nueve "
End If
Unidades = cTexto
cTexto = ""
End Function