Fechador: Establece la fecha automaticamente al cambiar un dato

Descargar el fichero: fechador.xlsm

Fechador contiene una macro que establece la fecha y la hora junto a cierta celda cuando ésta experimenta cambios. Esto se logra manejando los eventos, concretamente el evento Change que detecta cuando se produce un cambio en alguna celda de una hoja. Podemos ejecutar la macro cuando el cambio se produzca en todas las celdas, o bien únicamente en una de ellas, o en un rango, y esto lo conseguimos manejando el target. Veamos cómo se hace.

Hoja 1

Al escribir en cualquier celda de la columna D, y en particular en las celdas verdes, y bajo ellas, al pulsar INTRO, automáticamente se anotará en la celda de la derecha la fecha y hora actuales, siempre que su ordenador esté correctamente puesto en fecha y hora.

Esto se consigue con una pequeña macro que se ha de escribir, no en un Módulo como es habitual al programar macros, sino en la Hoja1. Vea la siguiente imagen. Por cierto, para pasar de un elemento a otro de los de la imagen, o de un módulo a otro, no basta con hacer click con el ratón, se ha de hacer doble click.

Al situarnos dentro del Editor de Visual Basic en la Hoja1, a la derecha aparecerá la posibilidad de manejar dos desplegables. Hemos de elegir "Worksheet" en el de la izquierda y "Change" en le de la derecha.

Código:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.MoveAfterReturn = False
If Target.Count = 1 Then
  If (Target.Column = 4 And Target <> 0) Then
    Target.Offset(0, 1) = Now
  End If
End If
End Sub

Hoja 2

Nos situamos ahora en la Hoja 2. En este caso pretendemos que se indique la fecha y la hora de forma automática en la columna E, siempre que se efectúen anotaciones o cambios en cualquier celda del rango B7:D20.

Vamos al Editor de Visual Basic, y en el Explorador de Proyectos nos situamos en la Hoja2. Para ello debemos pulsar doble click sobre la Hoja2, tal y como se muestra en la siguiente imagen.

En este caso la macro cambia ligeramente.

Código:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.MoveAfterReturn = False
If Target.Count = 1 Then
  If Not Intersect(Target, Range("B5:D39")) Is Nothing Then
    Cells(Target.Row, "E") = Now
  End If
End If
End Sub