Hola amigos
necesito una macro, no función, macro que cuando desde mi formulario escriba una fecha y un monto cualquiera, al pasarla al excel planilla, en la celda continua se escriba, es decir, si yo escribo la fecha 12/03/1975, en la celda de al lado se escriba automáticamente, 12 de marzo de 1975, y con respecto a las cifras ejemplo 500.000, que se escriba en la celda de al lado Quinientos mil.
Para la fecha
para las cifras
la macro que tengo pero funcion y necesito una macro:
de antemano muchas gracias
necesito una macro, no función, macro que cuando desde mi formulario escriba una fecha y un monto cualquiera, al pasarla al excel planilla, en la celda continua se escriba, es decir, si yo escribo la fecha 12/03/1975, en la celda de al lado se escriba automáticamente, 12 de marzo de 1975, y con respecto a las cifras ejemplo 500.000, que se escriba en la celda de al lado Quinientos mil.
Para la fecha
para las cifras
la macro que tengo pero funcion y necesito una macro:
VBA Code:
Function NumLetrasPais(Valor As Currency, pais As String) As String
Dim lyCantidad As Currency, lyCentavos As Long, lnDigito As Byte, lnPrimerDigito As Byte, lnSegundoDigito As Byte, lnTercerDigito As Byte, lcBloque As String, lnNumeroBloques As Byte, lnBloqueCero
Dim laUnidades As Variant, laDecenas As Variant, laCentenas As Variant, I As Variant 'Si esta como Option Explicit
Dim ValorEntero As Long
Dim cant_letras As String
pais = UCase(pais)
Valor = Round(Valor, 2)
lyCantidad = Int(Valor)
ValorEntero = lyCantidad
cant_letras = ValorALetras(ValorEntero)
Select Case pais
Case "CL"
NumLetrasPais = cant_letras & " "
End Select
End Function
Function ValorALetras(Valor As Long) As String
Dim lyCantidad As Currency, lnDigito As Byte, lnPrimerDigito As Byte, lnSegundoDigito As Byte, lnTercerDigito As Byte, lcBloque As String, lnNumeroBloques As Byte, lnBloqueCero
Dim laUnidades As Variant, laDecenas As Variant, laCentenas As Variant, I As Variant 'Si esta como Option Explicit
Dim ValorEntero As Long
Valor = Round(Valor, 2)
lyCantidad = Int(Valor)
ValorEntero = lyCantidad
laUnidades = Array("UN", "DOS", "TRES", "CUATRO", "CINCO", "SEIS", "SIETE", "OCHO", "NUEVE", "DIEZ", "ONCE", "DOCE", "TRECE", "CATORCE", "QUINCE", "DIECISEIS", "DIECISIETE", "DIECIOCHO", "DIECINUEVE", "VEINTE", "VEINTIUN", "VEINTIDOS", "VEINTITRES", "VEINTICUATRO", "VEINTICINCO", "VEINTISEIS", "VEINTISIETE", "VEINTIOCHO", "VEINTINUEVE")
laDecenas = Array("DIEZ", "VEINTE", "TREINTA", "CUARENTA", "CINCUENTA", "SESENTA", "SETENTA", "OCHENTA", "NOVENTA")
laCentenas = Array("CIENTO", "DOSCIENTOS", "TRESCIENTOS", "CUATROCIENTOS", "QUINIENTOS", "SEISCIENTOS", "SETECIENTOS", "OCHOCIENTOS", "NOVECIENTOS")
lnNumeroBloques = 1
Do
lnPrimerDigito = 0
lnSegundoDigito = 0
lnTercerDigito = 0
lcBloque = ""
lnBloqueCero = 0
For I = 1 To 3
lnDigito = lyCantidad Mod 10
If lnDigito <> 0 Then
Select Case I
Case 1
lcBloque = " " & laUnidades(lnDigito - 1)
lnPrimerDigito = lnDigito
Case 2
If lnDigito <= 2 Then
lcBloque = " " & laUnidades((lnDigito * 10) + lnPrimerDigito - 1)
Else
lcBloque = " " & laDecenas(lnDigito - 1) & IIf(lnPrimerDigito <> 0, " Y", Null) & lcBloque
End If
lnSegundoDigito = lnDigito
Case 3
lcBloque = " " & IIf(lnDigito = 1 And lnPrimerDigito = 0 And lnSegundoDigito = 0, "CIEN", laCentenas(lnDigito - 1)) & lcBloque
lnTercerDigito = lnDigito
End Select
Else
lnBloqueCero = lnBloqueCero + 1
End If
lyCantidad = Int(lyCantidad / 10)
If lyCantidad = 0 Then
Exit For
End If
Next I
Select Case lnNumeroBloques
Case 1
ValorALetras = lcBloque
Case 2
ValorALetras = lcBloque & IIf(lnBloqueCero = 3, Null, " MIL") & ValorALetras
Case 3
ValorALetras = lcBloque & IIf(lnPrimerDigito = 1 And lnSegundoDigito = 0 And lnTercerDigito = 0, " MILLON", " MILLONES") & ValorALetras
End Select
lnNumeroBloques = lnNumeroBloques + 1
Loop Until lyCantidad = 0
End Function
Dim Letras As Variant, N As Currency, E As Long, L As Variant, M As Long, Z As Long
Dim U As Variant, D As Variant, D1 As Variant, D2 As Variant, C As Variant
Function MACROLETRAS(Número As Double) As Variant: On Error Resume Next
MACROLETRAS = ""
N = Número
U = Array("", "UNO", "DOS", "TRES", "CUA-TRO", "CIN-CO", "SEIS", "SIE-TE", "OCHO", "NUE-VE", "DIEZ")
D = Array("", "DIEZ", "VEIN-TE", "TREIN-TA", "CUA-REN-TA", "CIN-CUEN-TA", "SE-SEN-TA", "SE-TEN-TA", "OCHEN-TA", "NO-VEN-TA", "CIEN")
D1 = Array("", "ON-CE", "DO-CE", "TRE-CE", "CA-TOR-CE", "QUIN-CE", "DIE-CI-SEIS", "DIE-CI-SIE-TE", "DIE-CIO-CHO", "DIE-CI-NUE-VE", "VEIN-TE")
D2 = Array("", "VEIN-TIUN", "VEIN-TI-DOS", "VEIN-TI-TRES", "VEIN-TI-CUATRO", "VEIN-TIC-INCO", "VEIN-TIS-EIS", "VEIN-TI-SIE-TE", "VEIN-TI-OCHO", "VEIN-TI-NUE-VE", "TREIN-TA")
C = Array("", "CIEN-TO", "DOS-CIEN-TOS", "TRES-CIEN-TOS", "CUATRO-CIEN-TOS", "QUI-NI-EN-TOS", "SEIS-CIEN-TOS", "SE-TE-CIEN-TOS", "OCHO-CIEN-TOS", "NO-VE-CIEN-TOS", "MIL")
If N = 0 Then Exit Function
E = Int(N)
M = (N - E) * 100
Letras = ""
Z = 0
'----------------------MILLONES
U(1) = "UN"
If E > 999999 Then
Z = Int(E / 1000000)
HASTA_1000 Z, False
If Z = 1 Then
Letras = L & " MILLON "
Else
Letras = L & " MILLONES "
End If
E = E - (Z * 1000000)
End If
'------------------------MILES
U(1) = ""
If E > 999 Then
Z = Int(E / 1000)
HASTA_1000 Z, True
Letras = Letras & L & " MIL "
E = E - (Z * 1000)
End If
'------------------------CIENTOS
If E > 0 Then
U(1) = "UN"
HASTA_1000 E, False
Letras = Letras & L
End If
'------------------------CENTIMOS
If M > 0 Then
HASTA_1000 M, False
If Int(N) > 0 Then
Letras = Letras & " CON" & L & " CENTIMOS"
Else
Letras = L & " CENTIMOS"
End If
End If
Letras = Replace(Letras, " ", " ")
Letras = Replace(Letras, "-", "")
If Right(Letras, 2) = "UN" Then Letras = Letras + "O"
MACROLETRAS = Trim(Letras)
End Function
Private Sub HASTA_1000(ByVal CIFRA As Long, MILES As Boolean)
L = ""
If CIFRA = 0 Then Exit Sub
'-----------------------------------------------------
If CIFRA > 100 Then 'CENTENAS
X = Int(CIFRA / 100)
L = C((CIFRA - CIFRA Mod 100) / 100)
CIFRA = CIFRA - (X * 100)
End If
If CIFRA < 11 Then 'UNIDADES
L = L & " " & U(CIFRA)
Exit Sub
End If
If CIFRA < 21 Then 'DIECES
L = L & " " & D1(CIFRA - 10)
Exit Sub
End If
If CIFRA < 31 Then 'VEINTES
L = L & " " & D2(CIFRA - 20)
Exit Sub
End If
If CIFRA < 101 Then 'RESTO DECENAS
X = CIFRA Mod 10
L = L & " " & D((CIFRA - X) / 10)
If X > 0 Then L = L & " Y " & U(X)
Exit Sub
End If
End Subde antemano muchas gracias
