Convertir numero en texto
Mario G
al momento de poner un numero, este se pueda poner en
otra celda como texto. Esto es para poder hacer mis
facturas y no se me olvide poner la cantidad en letra,
sino que lo haga en automatico
Gracias por la ayuda
anon...@discussions.microsoft.com
¡Por favor, que alguien haga una rutina para convertir
números a texto!
Si nadie la hace, la haré yo, pero será en septiembre.
>-----Mensaje original-----
>.
>
Nico
ami me funciona
Public Sub Numero_A_Letras()
Dim strValor As String
Dim strRes As String
Dim dblValor As Double
Dim Estilo As Byte
strValor = ActiveCell
If strValor = "" Or Not IsNumeric(strValor) Then
MsgBox "Debes seleccionar una celda con un número
valido", _
vbInformation, _
"Números a letras"
Else
strRes = Trim(InputBox("¿Que estilo deseas?" & vbCrLf
& vbCrLf & _
"1 = MAYUSCULAS" & vbCrLf & _
"2 = minusculas" & vbCrLf & _
"3 = Tipo Titulo", "Numeros a
letras", "1"))
If Len(strRes) = 0 Then
MsgBox "Cancelaste la macro",
vbInformation, "Números a letras"
Else
Estilo = Val(strRes)
If Estilo < 1 Or Estilo > 3 Then Estilo = 1
dblValor = CDbl(strValor)
ActiveCell.Offset(0, 1) = Format(dblValor, "$
#,##0.00 ") & NumLetras(dblValor, Estilo)
End If
End If
End Sub
Public Function NumLetras(ByVal Numero As Double, ByVal
Estilo As Integer) As String
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
If Numero < 0 Then Numero = Abs(Numero)
NumTmp = Format(Numero, "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))
Select Case c02
Case 1: cen = dig
Case 2: dec = dig
Case 3: uni = dig
End Select
c02 = c02 + 1
pos = pos + 1
Loop
letra3 = Centena(uni, dec, cen)
letra2 = Decena(uni, dec)
letra1 = Unidad(uni, dec)
Select Case c01
Case 1
If cen + dec + uni = 1 Then
Leyenda = "Billon "
ElseIf cen + dec + uni > 1 Then
Leyenda = "Billones "
End If
Case 2
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
Case 3
If cen + dec = 0 And uni = 1 Then
Leyenda = "Millon "
ElseIf cen > 0 Or dec > 0 Or uni > 1 Then
Leyenda = "Millones "
End If
Case 4
If cen + dec + uni >= 1 Then
Leyenda = "Mil "
End If
Case 5
If cen + dec + uni >= 1 Then
Leyenda = ""
End If
End Select
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 con "
ElseIf Val(Mid(NumTmp, 4, 12)) = 0 Or Val(Mid(NumTmp,
10, 6)) = 0 Then
Leyenda1 = "de Pesos "
Else
Leyenda1 = "Pesos con "
End If
TFNumero = TFNumero & Leyenda1
Select Case Estilo
Case 1
TFNumero = StrConv(TFNumero, vbUpperCase)
Case 2
TFNumero = StrConv(TFNumero, vbLowerCase)
Case Else
TFNumero = StrConv(TFNumero, vbProperCase)
End Select
TFNumero = "(" & TFNumero & Mid(NumTmp, 17) & "/100)"
NumLetras = TFNumero
End Function
Private Function Centena(ByVal uni As Integer, ByVal dec
As Integer, _
ByVal cen As Integer) As String
Dim cTexto As String
Select Case cen
Case 1
If dec + uni = 0 Then
cTexto = "cien "
Else
cTexto = "ciento "
End If
Case 2: cTexto = "doscientos "
Case 3: cTexto = "trescientos "
Case 4: cTexto = "cuatrocientos "
Case 5: cTexto = "quinientos "
Case 6: cTexto = "seiscientos "
Case 7: cTexto = "setecientos "
Case 8: cTexto = "ochocientos "
Case 9: cTexto = "novecientos "
Case Else: cTexto = ""
End Select
Centena = cTexto
End Function
Private Function Decena(ByVal uni As Integer, ByVal dec As
Integer) As String
Dim cTexto As String
Select Case dec
Case 1:
Select Case uni
Case 0: cTexto = "diez "
Case 1: cTexto = "once "
Case 2: cTexto = "doce "
Case 3: cTexto = "trece "
Case 4: cTexto = "catorce "
Case 5: cTexto = "quince "
Case 6 To 9: cTexto = "dieci"
End Select
Case 2:
If uni = 0 Then
cTexto = "veinte "
ElseIf uni > 0 Then
cTexto = "veinti"
End If
Case 3: cTexto = "treinta "
Case 4: cTexto = "cuarenta "
Case 5: cTexto = "cincuenta "
Case 6: cTexto = "sesenta "
Case 7: cTexto = "setenta "
Case 8: cTexto = "ochenta "
Case 9: cTexto = "noventa "
Case Else: cTexto = ""
End Select
If uni > 0 And dec > 2 Then cTexto = cTexto + "y "
Decena = cTexto
End Function
Private Function Unidad(ByVal uni As Integer, ByVal dec As
Integer) As String
Dim cTexto As String
If dec <> 1 Then
Select Case uni
Case 1: cTexto = "un "
Case 2: cTexto = "dos "
Case 3: cTexto = "tres "
Case 4: cTexto = "cuatro "
Case 5: cTexto = "cinco "
End Select
End If
Select Case uni
Case 6: cTexto = "seis "
Case 7: cTexto = "siete "
Case 8: cTexto = "ocho "
Case 9: cTexto = "nueve "
End Select
Unidad = cTexto
End Function
Arriba México
>-----Mensaje original-----
>.
>
tijuana dude
problema es ke yo solamente se usar excel para lo basico, todos dicen
"agrega este modulo pero nadie dice como crearlo ni como usarlo una
vez creado, si fueran tam amables de contribuir con la gente ke no
conocemos excel bien y ke lo usamos para lo basico se les agradeceria
mucho, yo necesito esto para mis facturas pues tengo ke capturar el
dato manualmente y seguido de le olvida, asi ke ya se pueden imaginar
el coraje ke me da cada vez ke arruino una factura, bueno, en fin,
espero ke alguie postee unas instrucciones de como meter el codigo al
modulo, y ke diga cuales correcciones hay ke hacerle y ke cosas hay ke
modificarle. gracias de antemano, hasta luego.
"Nico" <anon...@discussions.microsoft.com> wrote in message news:<289e401c46463$31f07a80$a401...@phx.gbl>...
> Prueba este codigo en un modulo
> ami me funciona
> Public Sub Numero A Letras()
> Dim strValor As String
> Dim strRes As String
> Dim dblValor As Double
> Dim Estilo As Byte
>
> strValor = ActiveCell
> If strValor = "" Or Not IsNumeric(strValor) Then
> MsgBox "Debes seleccionar una celda con un n mero
> valido",
> vbInformation,
> "N meros a letras"
> Else
> strRes = Trim(InputBox(" Que estilo deseas?" & vbCrLf
> & vbCrLf &
> "1 = MAYUSCULAS" & vbCrLf &
> "2 = minusculas" & vbCrLf &
> "3 = Tipo Titulo", "Numeros a
> letras", "1"))
> If Len(strRes) = 0 Then
> MsgBox "Cancelaste la macro",
> vbInformation, "N meros a letras"
> Arriba M xico
> >-----Mensaje original-----
> >Esta pregunta se repite m s que el ajo.
> > Por favor, que alguien haga una rutina para convertir
> >n meros a texto!
> >
> >Si nadie la hace, la har yo, pero ser en septiembre.
Sergio A Campos H
Para crear un nuevo Módulo e insetar la macro es:
Menú >> Herramientas > Macro > Editor de Visual Basic (Alt + F11).
Estando en el Editor: Menú >> Insertar > Módulo.
Pegas el conternido de la macro.
Para poder utilizar esta función en tu hoja de trabajo es:
Suponiendo que el número está en A1:
=Módulo1.Numletras(A1,1)
'Aquí comienaz el código de la macro.
Option Explicit
Dim cTexto As String 'Variable para las funciones
Public Function Numletras(ByVal Numero As Double, ByVal Mayusculas As
Integer) As String
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
If Numero < 0 Then Numero = Abs(Numero)
NumTmp = Format(Numero, "000000000000000.00") 'Le da un formato
fijo
c01 = 1
pos = 1
TFNumero = "Son:"
Loop
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.)"
If Mayusculas = 1 Then
TFNumero = UCase(TFNumero)
Else
TFNumero = LCase(TFNumero)
End If
Numletras = TFNumero
End Function
Private Function Centena(ByVal uni As Integer, ByVal dec As Integer, ByVal
cen As Integer) As String
Select Case cen
Case 1
If dec + uni = 0 Then
cTexto = "cien "
Else
cTexto = "ciento "
End If
Case 2: cTexto = "doscientos "
Case 3: cTexto = "trescientos "
Case 4: cTexto = "cuatrocientos "
Case 5: cTexto = "quinientos "
Case 6: cTexto = "seiscientos "
Case 7: cTexto = "setecientos "
Case 8: cTexto = "ochocientos "
Case 9: cTexto = "novecientos "
Case Else: cTexto = ""
End Select
Centena = cTexto
cTexto = ""
End Function
Private Function Decena(ByVal uni As Integer, ByVal dec As Integer) As
String
Select Case dec
Decena = cTexto
cTexto = ""
End Function
Private Function Unidad(ByVal uni As Integer, ByVal dec As Integer) As
String
If dec <> 1 Then
Select Case uni
Case 1: cTexto = "un "
Case 2: cTexto = "dos "
Case 3: cTexto = "tres "
Case 4: cTexto = "cuatro "
Case 5: cTexto = "cinco "
End Select
End If
Select Case uni
Case 6: cTexto = "seis "
Case 7: cTexto = "siete "
Case 8: cTexto = "ocho "
Case 9: cTexto = "nueve "
End Select
Unidad = cTexto
cTexto = ""
End Function
--
A sus órdenes.
Tec. Inf. Sergio A Campos H
Victor Manuel Tapia Vargas
>-----Mensaje original-----
>
lo siguiente te puede servir. copialo y pegalo en un
modulo nuevo del editor de VB y para utilizarlo teclea en
la hoja de calculo =ENLETRAS(celda), donde celda es donde
tienes el numero que quieres traducir
Function EnLetras(Valor) As String ' Función Principal '
If Not IsNumeric(Valor) Then
EnLetras = "¡ La referencia no es valor o... 'excede'
la precisión !!!":
Exit Function
End If: Dim Moneda As String, Fracs As String, Cents As
Integer
If Int(Abs(Valor)) = 1 Then Moneda = " PESO " Else
Moneda = " PESOS "
If Right(Letras(Abs(Valor)), 6) = "ILLON " Or Right
(Letras(Abs(Valor)), 8) = "ILLONES " Then Moneda = "DE" &
Moneda
Cents = Application.Round(Abs(Valor) - Int(Abs(Valor)),
2) * 100
'If Cents = 1 Then Fracs = " centavo " Else Fracs = "
centavos "
If Cents = 0 Then EnLetras = "( " & Letras(Int(Abs
(Valor))) & Moneda & Fracs & "00/100 M.N. )" Else EnLetras
= "( " & Letras(Int(Abs(Valor))) & Moneda & Fracs & Cents
& "/100 M.N. )"
'If Valor < 0 Then EnLetras = "menos " & EnLetras
End Function
Private Function Letras(Valor) As String
' Función Auxiliar [uso 'exclusivo'de la
función 'principal'] '
Select Case Int(Valor)
Case 0: Letras = "CERO"
Case 1: Letras = "UN"
Case 2: Letras = "DOS"
Case 3: Letras = "TRES"
Case 4: Letras = "CUATRO"
Case 5: Letras = "CINCO"
Case 6: Letras = "SEIS"
Case 7: Letras = "SIETE"
Case 8: Letras = "OCHO"
Case 9: Letras = "NUEVE"
Case 10: Letras = "DIEZ"
Case 11: Letras = "ONCE"
Case 12: Letras = "DOCE"
Case 13: Letras = "TRECE"
Case 14: Letras = "CATORCE"
Case 15: Letras = "QUINCE"
Case Is < 20: Letras = "DIECI" & Letras(Valor - 10)
Case 20: Letras = "VEINTE"
Case Is < 30: Letras = "VEINTI" & Letras(Valor - 20)
Case 30: Letras = "TREINTA"
Case 40: Letras = "CUARENTA"
Case 50: Letras = "CINCUENTA"
Case 60: Letras = "SESENTA"
Case 70: Letras = "SETENTA"
Case 80: Letras = "OCHENTA"
Case 90: Letras = "NOVENTA"
Case Is < 100: Letras = Letras(Int(Valor \ 10) * 10)
& " Y " & Letras(Valor Mod 10)
Case 100: Letras = "CIEN"
Case Is < 200: Letras = "CIENTO " & Letras(Valor - 100)
Case 200, 300, 400, 600, 800: Letras = Letras(Int
(Valor \ 100)) & "CIENTOS"
Case 500: Letras = "QUINIENTOS"
Case 700: Letras = "SETECIENTOS"
Case 900: Letras = "NOVECIENTOS"
Case Is < 1000: Letras = Letras(Int(Valor \ 100) *
100) & " " & Letras(Valor Mod 100)
Case 1000: Letras = "UN MIL"
Case Is < 2000: Letras = "UN MIL " & Letras(Valor Mod
1000)
Case Is < 1000000: Letras = Letras(Int(Valor \ 1000))
& " MIL"
If Valor Mod 1000 Then Letras = Letras & " " & Letras
(Valor Mod 1000)
Case 1000000: Letras = "UN MILLON "
Case Is < 2000000: Letras = "UN MILLON " & Letras
(Valor Mod 1000000)
Case Is < 1000000000000#: Letras = Letras(Int(Valor /
1000000)) & " MILLONES "
If (Valor - Int(Valor / 1000000) * 1000000) _
Then Letras = Letras & Letras(Valor - Int(Valor /
1000000) * 1000000)
Case 1000000000000#: Letras = "UN BILLON "
Case Is < 2000000000000#
Letras = "UN BILLON " & Letras(Valor - Int(Valor /
1000000000000#) * 1000000000000#)
Case Else: Letras = Letras(Int(Valor /
1000000000000#)) & " BILLONES "
If (Valor - Int(Valor / 1000000000000#) *
1000000000000#) Then Letras = Letras & " " & Letras(Valor -
Int(Valor / 1000000000000#) * 1000000000000#)
End Select
End Function