Excel VBA - Cálculo y adición de meses a fechas en cuadros TextBox en formulario

Agradezco mucho la ayudan que dan.

Tengo un formulario en donde TextBox1 se coloca la fecha inicial formato dd/mm/yyyy en el TextBox2 se colocan los meses (que pueden ser más de 12)

Y en el TextBox3 el resultado de la suma de los meses a la fecha de TextBox1.
Si no coloco meses en TextBox2, en TextBox3 solo digito el mes correspondiente.

He hecho este código que creo que estoy en buen camino pero no me da resultados. Al digitar la fecha inicial en un TextBox1, digitar los meses en TextBox2 y darle TAB o Enter después no aparece nada en TextBox3.

Private Sub TextBox3_AfterUpdate()

Dim FinContrato As Date
Dim MesesRenovar As Integer
Dim InicioContrato As Date

InicioContrato = DateValue(TextBox1)
MesesRenovar = Val(TextBox2)
FinContrato = DateValue(TextBox3)

If IsNumeric(TextBox2) Then
TextBox3 = DateAdd("m", MesesRenovar.Value, Date)
End If

End Sub

He googleado algunas formas pero creo que no hay muchos ejemplos de casos como el mío con puros TextBox.

Las variables son porque hago una minimacro de cálculo de contratos.

Disculpen la molestia :(

1 respuesta

Respuesta
1

En primer lugar supongo que has colocado los controles y el código en un formulario (UserForm).

Pero no puedes asociar ese codigo a un evento 'AfterUpdate' !

Debes asociarlo al evento "TextBox2.exit", asi se ejecutará cuando el textbox2 pierda el enfoque.

Tienes algunos errores en código que te he corregido:

Tambien he añadido un sub para limpiar TextBox3 al cambiar TextBox1.

____________________________________________________________

Private Sub TextBox1_Change()    'Limpia TextBox3
TextBox3 = ""
End Sub

_______________________________________________________

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

If IsDate(TextBox1) Then

Dim FinContrato As Date
Dim MesesRenovar As Integer
Dim InicioContrato As Date

InicioContrato = DateValue(TextBox1)
MesesRenovar = Val(TextBox2)

If IsNumeric(TextBox2) Then
TextBox3 = DateAdd("m", MesesRenovar, InicioContrato) 'ERROR=MesesRenovar.Value
FinContrato = DateValue(TextBox3) ' Solo puedes dar valor a FinContrato cuando TextBox3 es válido
End If

End If
End Sub

¡Gracias por tu ayuda!

Verás, al ver los resultados de mi macro me di cuenta que no calculaba 1 mes de contrato como debía ya que la programación solo cambiaba la línea del mes, por ejemplo: Al poner 1 mes a un contrato que empieza el 01/02/2018 me salía 01/03/2018 lo cual no estaba bien porque debía ser 02/03/2018.

Para ayudarme modifiqué tu código donde uno pone los meses pero por dentro calcula en base a treinta días y coge el campo día (en los contratos cada mes es 30 días) y me salió bien exacto. 

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

If IsDate(TextBox1) Then

Dim FinContrato As Date
Dim MesesRenovar As Integer
Dim InicioContrato As Date

InicioContrato = DateValue(TextBox1)
MesesRenovar = (Val(TextBox2)*30)-1

If IsNumeric(TextBox2) Then
TextBox3 = DateAdd("d", MesesRenovar, InicioContrato) 
FinContrato = DateValue(TextBox3) 
End If

End If
End Sub

Tengo una consulta que al parecer no entiendo.

¿En qué ocasiones usas el evento Change, Exit o AfterUpdate que usé en mi macro? ¿En qué se diferencian? Tal vez una aplicación práctica de cada uno me ayude a entender y escoger mejor el evento. Creo entender que en el evento Exit al decir "cuando pierde el enfoque" es cuando pasas a otra línea o textbox con Tab, presionando Enter o dando click a otro lado.

Te intento aclarar las diferencias entre los eventos:

Enter se ejecuta al obtener el enfoque, es decir 'al entrar'

Exit al salir independientemente de si sales pulsando enter, tab o click en otro lugar

Change cada vez que realizas cualquier cambio

AfterUpdate al salir, pero sólo si has realizado algún cambio.

Ten en cuenta que Change y AfterUpdate no se ejecuta si no hay cambios, mientras que enter y exit se ejecutan cada vez que entres o salgas independientemente de si has cambiado algo o no

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas