Macro para cambiar números a letras no funciona en otros archivos
Function CONVERTIRNUM(Numero As Double, Optional CentimosEnLetra As Boolean) As String Dim Moneda As String Dim Monedas As String Dim Centimo As String Dim Centimos As String Dim Preposicion As String Dim NumCentimos As Double Dim Letra As String Const Maximo = 1999999999999.99 Moneda = "Peso" 'Nombre de Moneda (Singular) Monedas = "Pesos" 'Nombre de Moneda (Plural) Centimo = "Centavo" 'Nombre de Céntimos (Singular) Centimos = "Centavos" 'Nombre de Céntimos (Plural) Preposicion = "Con" 'Preposición entre Moneda y Céntimos ''Validar que el Numero está dentro de los límites If (Numero >= 0) And (Numero <= Maximo) Then Letra = NUMERORECURSIVO((Fix(Numero))) 'Convertir el Numero en letras 'Si Numero = 1 agregar leyenda Moneda (Singular) If (Numero = 1) Then Letra = Letra & " " '& Moneda 'De lo contrario agregar leyenda Monedas (Plural) Else Letra = Letra & " " '& Monedas End If 'NumCentimos = Round((Numero - Fix(Numero)) * 100) 'Obtener los centimos del Numero NumCentimos = Round((Numero - Fix(Numero)) * 10) 'Obtener los centimos del Numero 'Si NumCentimos es mayor a cero inicar la conversión If NumCentimos >= 0 Then 'Si el parámetro CentimosEnLetra es VERDADERO obtener letras para los céntimos If CentimosEnLetra Then Letra = Letra & " " & Preposicion & " " & NUMERORECURSIVO(Fix(NumCentimos)) 'Convertir los céntimos en letra 'Si NumCentimos = 1 agregar leyenda Centimos (Singular) If (NumCentimos = 1) Then Letra = Letra & " " '& Centimo 'De lo contrario agregar leyenda Centimos (Plural) Else Letra = Letra & " " '& Centimos End If 'De lo contrario mostrar los céntimos como número Else If NumCentimos < 10 Then 'Letra = Letra & " 0" & NumCentimos & "/100" Else 'Letra = Letra & " " & NumCentimos & "/100" End If End If End If If Right(Letra, 9) = "Millones " Then Letra = Letra & "de " End If 'Regresar el resultado final de la conversión CONVERTIRNUM = Letra & " pesos M/C" Else 'Si el Numero no está dentro de los límites, entivar un mensaje de error CONVERTIRNUM = "ERROR: El número excede los límites." End If End Function
el codigo no me funciona sino desde el archivo que corro la macro, en lo que creo masivos me sale error de #¿NOMBRE?
Respuesta de Dante Amor
2
Te faltó poner la función NUMERORECURSIVO, también debe ir en el mismo módulo.
Function NUMERORECURSIVO(Numero As Long) As String
Dim Unidades, Decenas, Centenas
Dim Resultado As String
'**************************************************
' Nombre de los números
'**************************************************
Unidades = Array("", "Un", "Dos", "Tres", "Cuatro", "Cinco", "Seis", "Siete", "Ocho", "Nueve", "Diez", "Once", "Doce", "Trece", "Catorce", "Quince", "Dieciséis", "Diecisiete", "Dieciocho", "Diecinueve", "Veinte", "Veintiuno", "Veintidos", "Veintitres", "Veinticuatro", "Veinticinco", "Veintiseis", "Veintisiete", "Veintiocho", "Veintinueve")
Decenas = Array("", "Diez", "Veinte", "Treinta", "Cuarenta", "Cincuenta", "Sesenta", "Setenta", "Ochenta", "Noventa", "Cien")
Centenas = Array("", "Ciento", "Doscientos", "Trescientos", "Cuatrocientos", "Quinientos", "Seiscientos", "Setecientos", "Ochocientos", "Novecientos")
'**************************************************
Select Case Numero
Case 0
Resultado = "Cero"
Case 1 To 29
Resultado = Unidades(Numero)
Case 30 To 100
Resultado = Decenas(Numero \ 10) + IIf(Numero Mod 10 <> 0, " y " + NUMERORECURSIVO(Numero Mod 10), "")
Case 101 To 999
Resultado = Centenas(Numero \ 100) + IIf(Numero Mod 100 <> 0, " " + NUMERORECURSIVO(Numero Mod 100), "")
Case 1000 To 1999
Resultado = "Mil" + IIf(Numero Mod 1000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000), "")
Case 2000 To 999999
Resultado = NUMERORECURSIVO(Numero \ 1000) + " Mil" + IIf(Numero Mod 1000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000), "")
Case 1000000 To 1999999
Resultado = "Un Millón" + IIf(Numero Mod 1000000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000000), "")
Case 2000000 To 1999999999
Resultado = NUMERORECURSIVO(Numero \ 1000000) + " Millones" + IIf(Numero Mod 1000000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000000), "")
End Select
NUMERORECURSIVO = Resultado
End Function¿El número está en otro libro?
¿El resultado lo quieres en otra hoja de otro libro?
Si, el número esta en otro libro que se crea con una macro
Si, lo quiero en la hoja 1 de los archivos que se crean masivamente con una macro.
ya puse la función NUMERORECURSIVO, sin embargo no funcionó
Vamos por partes.
1. ¿En cuál celda vas a poner las letras?
2. ¿Cuál celda tiene el número?
[Recuerda que debes proporcionar imágenes para explicar qué necesitas.
[SIN EJEMPLO, es muy complicado entender.
¡Gracias!
Va en la celda a38 y el número en c36 en cada uno de los libros que se crean
Prueba la siguiente macro Crear_Archivos, incluye convertir el número en letras.
Debes copiar TODO el código.
Sub Crear_Archivos()
'
'POR DANTE AMOR
'
Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim i As Long, j As Long, lr As Long
Dim ruta As String, fact As String, rutafin As String
'
'nombres de los 2 libros. LOS 2 LIBROS DEBEN ESTAR ABIERTOS
Set wb1 = Workbooks("listado.xlsx")
Set wb2 = Workbooks("nota crédito.xlsx")
Set sh1 = wb1.Sheets("Hoja1")
Set sh2 = wb2.Sheets("Hoja1")
'
ruta = "C:\2 BOMBEROS\BOMBEROS VOLUNTARIOS\"
ruta = "C:\trabajo\"
'
If Dir(ruta, vbDirectory) = "" Then
MsgBox "No existe la carpeta :" & ruta
Exit Sub
End If
'
lr = sh1.Range("A" & Rows.Count).End(3).Row
If lr = 1 Then Exit Sub
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
fact = sh1.Range("A" & 2).Value
Call Libro_Ruta(sh2, wb3, sh3, ruta, fact)
'
j = 14
For i = 2 To lr + 1
If fact <> sh1.Range("A" & i).Value Then
sh3.Range("A38").Value = CONVERTIRNUM(sh3.Range("C36").Value)
wb3.SaveAs rutafin & "\" & fact
wb3.Close False
'
If sh1.Range("A" & i).Value = "" Then Exit For
Call Libro_Ruta(sh2, wb3, sh3, ruta, sh1.Range("A" & i).Value)
j = 15
Else
j = j + 1
End If
sh3.Range("B11").Value = sh1.Range("A" & i).Value
sh3.Range("B12").Value = sh1.Range("B" & i).Value
sh3.Range("B13").Value = sh1.Range("C" & i).Value
'
sh3.Range("A" & j).Value = sh1.Range("D" & i).Value
sh3.Range("B" & j).Value = sh1.Range("E" & i).Value
sh3.Range("C" & j).Value = sh1.Range("F" & i).Value
'
fact = sh1.Range("A" & i).Value
rutafin = ruta & fact
Next
'
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
'
Sub Libro_Ruta(sh2 As Worksheet, wb3 As Workbook, sh3 As Worksheet, ruta As String, fact As String)
Dim rutafin As String
sh2.Copy
Set wb3 = ActiveWorkbook
Set sh3 = wb3.Sheets(1)
rutafin = ruta & fact
If Dir(rutafin, vbDirectory) = "" Then MkDir rutafin
End Sub
'
Function CONVERTIRNUM(Numero As Double, Optional CentimosEnLetra As Boolean) As String
Dim Moneda As String
Dim Monedas As String
Dim Centimo As String
Dim Centimos As String, letracentimos As String
Dim Preposicion As String
Dim NumCentimos As Double
Dim Letra As String
Const Maximo = 1999999999999.99
Moneda = "Peso" 'Nombre de Moneda (Singular)
Monedas = "Pesos" 'Nombre de Moneda (Plural)
Centimo = "Centavo" 'Nombre de Céntimos (Singular)
Centimos = "Centavos" 'Nombre de Céntimos (Plural)
Preposicion = "Con" 'Preposición entre Moneda y Céntimos
''Validar que el Numero está dentro de los límites
If (Numero >= 0) And (Numero <= Maximo) Then
Letra = NUMERORECURSIVO(Fix(Numero)) 'Convertir el Numero en letras
'Si Numero = 1 agregar leyenda Moneda (Singular)
' If (Numero = 1) Then
' Letra = Letra & " " '& Moneda
' 'De lo contrario agregar leyenda Monedas (Plural)
' Else
' Letra = Letra & " " '& Monedas
' End If
NumCentimos = Round((Numero - Fix(Numero)) * 100) 'Obtener los centimos del Numero
'Si NumCentimos es mayor a cero inicar la conversión
If NumCentimos >= 0 Then
'Si el parámetro CentimosEnLetra es VERDADERO obtener letras para los céntimos
If CentimosEnLetra Then
Letra = Letra & " " & Preposicion & " " & NUMERORECURSIVO(Fix(NumCentimos)) 'Convertir los céntimos en letra
'Si NumCentimos = 1 agregar leyenda Centimos (Singular)
If (NumCentimos = 1) Then
Letra = Letra & " " '& Centimo
'De lo contrario agregar leyenda Centimos (Plural)
Else
Letra = Letra & " " '& Centimos
End If
'De lo contrario mostrar los céntimos como número
Else
letracentimos = Preposicion & " " & Format(NumCentimos, "00") & "/100"
End If
End If
' If Right(Letra, 9) = "Millones " Then
' Letra = Letra & "de "
' End If
'Regresar el resultado final de la conversión
CONVERTIRNUM = UCase(Letra & " " & letracentimos & " " & Monedas)
Else
'Si el Numero no está dentro de los límites, entivar un mensaje de error
CONVERTIRNUM = "ERROR: El número excede los límites."
End If
End Function
'
Function NUMERORECURSIVO(Numero As Double) As String
Dim Unidades, Decenas, Centenas
Dim Resultado As String
'**************************************************
' Nombre de los números
'**************************************************
Unidades = Array("", "Uno", "Dos", "Tres", "Cuatro", "Cinco", "Seis", "Siete", "Ocho", "Nueve", "Diez", "Once", "Doce", "Trece", "Catorce", "Quince", "Dieciséis", "Diecisiete", "Dieciocho", "Diecinueve", "Veinte", "Veintiun", "Veintidos", "Veintitres", "Veinticuatro", "Veinticinco", "Veintiseis", "Veintisiete", "Veintiocho", "Veintinueve")
Decenas = Array("", "Diez", "Veinte", "Treinta", "Cuarenta", "Cincuenta", "Sesenta", "Setenta", "Ochenta", "Noventa", "Cien")
Centenas = Array("", "Ciento", "Doscientos", "Trescientos", "Cuatrocientos", "Quinientos", "Seiscientos", "Setecientos", "Ochocientos", "Novecientos")
'**************************************************
Select Case Numero
Case 0
Resultado = "Cero"
Case 1 To 29
Resultado = Unidades(Numero)
Case 30 To 100
Resultado = Decenas(Numero \ 10) + IIf(Numero Mod 10 <> 0, " y " + NUMERORECURSIVO(Numero Mod 10), "")
Case 101 To 999
Resultado = Centenas(Numero \ 100) + IIf(Numero Mod 100 <> 0, " " + NUMERORECURSIVO(Numero Mod 100), "")
Case 1000 To 1999
Resultado = "Mil" + IIf(Numero Mod 1000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000), "")
Case 2000 To 999999
Resultado = NUMERORECURSIVO(Numero \ 1000) + " Mil" + IIf(Numero Mod 1000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000), "")
Case 1000000 To 1999999
Resultado = "Un Millón" + IIf(Numero Mod 1000000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000000), "")
Case 2000000 To 1999999999
Resultado = NUMERORECURSIVO(Numero \ 1000000) + " Millones" + IIf(Numero Mod 1000000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000000), "")
End Select
NUMERORECURSIVO = Resultado
End Function
