Fecha final en Textbox dependiendo de otro
Tengo un formulario llamado "Desembolsos"
De los Textbox que maneja:
TxtFecDesem
TxtTiem
TxtFecVenc
En el primero me aparece la fecha del día.
En el segundo por la cantidad de meses que durara el préstamo entre 1 y 36 meses
Deseo:
Que al poner la cantidad de meses en el TxtFecVenc me aparezca la fecha que deberá vencer el préstamo.
Lo sombreado en negrita al final del código me sale solo con un mes más a la fecha del día.
He sustituido el 1 por TxtTiem.value y me arroja error 13
Gracias.
Este es el código
'
'Option Explicit
'Dim ArchivoIMG As String
Private Sub Cmd_Desembolsos_Click()
Dim RESULTADO As String
'Evito movimientos en la pantalla
Application.ScreenUpdating = False
Sheets("Desembolsos").Activate
ActiveSheet.Cells(2, 1).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell = cbo_Codigo
ActiveCell.Offset(0, 1) = TxtCedula
ActiveCell.Offset(0, 2) = TxtNombres
ActiveCell.Offset(0, 3) = Format(Val(TxtDesem), "#,##0.00")
ActiveCell.Offset(0, 4) = TxtTasa / 100
ActiveCell.Offset(0, 5) = CmbTipo
ActiveCell.Offset(0, 6) = TxtTiem
ActiveCell.Offset(0, 7) = TxtFecDesem
ActiveCell.Offset(0, 8) = TxtFecVenc
ActiveCell.Offset(0, 9) = TxtComent
RESULTADO = MsgBox("PRESIONE: ACPTAR PARA CREAR EL CONTRATO O CANCEL PARA SALIR", vbOKCancel, "CONFIRMACION")
If RESULTADO = vbOK Then
MsgBox "CREAR EL CONTRATO"
Sheets("CONTRATO").Range("A1") = TxtCedula
Sheets("CONTRATO").Range("D1") = TxtDesem
Sheets("CONTRATO").Range("E1") = TxtTasa
Sheets("CONTRATO").Range("F1") = TxtTiem
'IMPRIMIR.Show
Else
MsgBox "SOLO REGISTRAR LOS DATOS"
End If
TxtCedula = ""
TxtNombres = ""
TxtDesem = ""
TxtTasa = ""
CmbTipo = ""
TxtTiem = ""
TxtFecDesem = ""
TxtFecVenc = ""
TxtComent = ""
TxtDesem.SetFocus
' Ordenar ' Esta es la llamada de nuestra macro para ordenar los registros
End Sub
Private Sub cmd_Cerrar_Click()
End
End Sub
Private Sub cbo_Codigo_Change()
On Error Resume Next
If nCliente(cbo_Codigo.Text) <> 0 Then
Sheets("Clientes").Activate
Cells(cbo_Codigo.ListIndex + 2, 1).Select
TxtCedula = ActiveCell.Offset(0, 1)
TxtNombres = ActiveCell.Offset(0, 2)
Fotografia.Picture = LoadPicture("")
Fotografia.Picture = LoadPicture(ActiveCell.Offset(0, 36))
ArchivoIMG = ActiveCell.Offset(0, 36)
Else
TxtCedula = ""
TxtNombres = ""
TxtDesem = ""
TxtTasa = ""
CmbTipo = ""
TxtTiem = ""
TxtFecDesem = ""
TxtFecVenc = ""
TxtComent = ""
ArchivoIMG = ""
'Hasta aqui
End If
End Sub
Private Sub cbo_Codigo_Enter()
CargarLista
End Sub
Sub CargarLista()
cbo_Codigo.Clear
Sheets("Clientes").Select
Range("a2").Select
Do While Not IsEmpty(ActiveCell)
cbo_Codigo.AddItem ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub Cmd_Limpiar_Click()
CargarLista
TxtCedula = ""
TxtNombres = ""
TxtFecReg = ""
TxtFecNac = ""
TxtDesem = ""
TxtTasa = ""
CmbTipo = ""
TxtTiem = ""
TxtFecDesem = ""
TxtFecVenc = ""
TxtComent = ""
ArchivoIMG = "" 'Hasta aqui
End Sub
Private Sub cmd_Imagen_Click()
On Error Resume Next
ArchivoIMG = Application.GetOpenFilename("Imágenes jpg,*.jpg,Imágenes bmp,*.bmp", 0, "Seleccionar Imágen para Reegistro de Clientes")
Fotografia.Picture = LoadPicture("")
Fotografia.Picture = LoadPicture(ArchivoIMG)
End Sub
Private Sub Cmd_Registrar_Click()
Unload Me
Registrar_Clientes.Show
End Sub
Private Sub Frame1_Click()
End Sub
Private Sub MostrarTodo_Click()
ThisWorkbook.Application.Visible = True
Call MostrarHojas
Me.MostrarTodo.Enabled = False
Me.OcultarTodo.Enabled = True
End Sub
Private Sub OcultarTodo_Click()
ThisWorkbook.Application.Visible = False
Call OcultarHojas
Me.MostrarTodo.Enabled = True
Me.OcultarTodo.Enabled = False
End Sub
Private Sub TxtFecVenc_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'seleccionamos de acuerdo a la longitud de los datos
'que estamos ingresando
Select Case Len(TxtFecVenc.Value)
'len = largo o longitud
Case 2
'si el textbox tiene 2 caracteres
TxtFecVenc.Value = TxtFecVenc.Value & "/"
'se colocará automáticamente una "/" luego del segundo caracter
Case 5
'si el textbox tiene 5 caracteres
TxtFecVenc.Value = TxtFecVenc.Value & "/"
'se colocará automáticamente una "/" luego del quinto caracter
End Select
End Sub
Private Sub TxtTiem_Change()
End Sub
Private Sub UserForm_Initialize()
CmbTipo. AddItem "INV"
CmbTipo. AddItem "NOR"
CmbTipo. AddItem "PLA"
CmbTipo. AddItem "TIEM"
CmbTipo. AddItem "REG"
CmbTipo. AddItem "MEN"
'
'CmbForma.AddItem "REG"
'CmbForma.AddItem "INT"
'
'
'Application.WindowState = xlMaximized
'Me.Width = Application.Width
'Me.Height = Application.Height
TxtFecDesem.Value = Date
TxtFecVenc.Value = DateAdd("m", 1, DateValue(TxtFecDesem))
End Sub
2 Respuestas
Primero, debes quitar esta línea, porque todavía no has capturado el número de meses
TxtFecVenc.Value = DateAdd("m", 1, DateValue(TxtFecDesem))Ahora debes agregar el evento change del textbox TxtTiem, de esta forma:
Private Sub TxtTiem_Change() 'Cuando capturas la cantidad de meses en el TxtTiem 'Entonces se actualiza la fecha de vencimiento TxtFecVenc.Value = "" If TxtTiem = 0 Or TxtTiem.Value = "" Or Not IsNumeric(TxtTiem) Then Exit Sub End If ' TxtFecVenc.Value = DateSerial(Year(Date), Month(Date) + TxtTiem, Day(Date)) End Sub
Listo, cada que captures un mes en el txtTiem, en automático se calcula la Fecha de vencimiento.
'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
la linea TxtFecVenc = DateAdd("m", TxtFecVenc.Text, fecha), te ahorra un buen de codigo al programar lo que te fallo fue el evento para estos casos no usas un evento change sino un evento afterupdate que te permite capturar toda la fecha antes de correr la macro mira el ejemplo, en el textfecvenc capture los meses y en ese mismo campo me coloco la fecha de vencimiento, otra cosa todo lo que captures en textbox aparecera como texto en el casod e las fechas primero tienes que transformarla en fechas con la instruccion cdate.
