Modificación código que incluya todos los meses
En un libro con doce hojas, con los nombres de cada uno de los meses del año, en una celda determinada de cada una de esta hojas, concretamente en la "AF1", tengo la fórmula "HOY()". Lo que pretendo es que la macro se ejecute cada vez que se abre el libro y revise la fecha cuando llega al último día del mes, lo deja fijo y ya no se actualiza la fecha. Esto lo tengo conseguido, el problema es que cada vez que cambia el mes, tengo que cambiar el código para que actúe con la siguiente hoja, donde se encuentra el subsiguiente mes.
Este es el código que tengo en ThisWorkBook
' ' La macro se ejecuta cada vez que se abre el libro y revisa la fecha
' cuando llega al último día del mes, lo deja fijo y ya no se actualiza la fecha
Private Sub Workbook_Open()
Set h1 = Sheets("ENE_17")
Set celda = h1.[AF1]
If Day(celda + 1) = 1 Then
celda.Value = celda.Value
End If
End SubMi pregunta es la siguiente, se puede automatizar esto; es decir, que cada vez que cambie el mes no sea necesario que yo tenga que modificar la parte del código con con la hoja del mes determinado.
2 Respuestas
H o la: Te anexo el código actualizado
Private Sub Workbook_Open() 'Act.Por.Dante Amor For Each h In Sheets If LCase(Left(h.Name, 3)) = Format(Date, "mmm") Then Set celda = h.[AF1] Next If Not celda Is Nothing Then If Day(celda + 1) = 1 Then celda.Value = celda.Value End If End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Perdona, me faltó declarar la variable, quedaría así:
Private Sub Workbook_Open() 'Act.Por.Dante Amor Dim celda As Object For Each h In Sheets If LCase(Left(h.Name, 3)) = Format(Date, "mmm") Then Set celda = h.[AF1] Next If Not celda Is Nothing Then If Day(celda + 1) = 1 Then celda.Value = celda.Value End Sub
sal u dos
17.01.17
Buenas noches,
La siguiente rutina coloca el último día de cada mes, cuando haya transcurrido, sin necesidad de que edites el código aún cuando cambie el año. Además permite que tengas otras hojas a las que no afectará.
Accede al Editor de VBA (Atajo: Alt + F11), allí inserta un módulo (Insertar-Módulo) y pega el siguiente código:
Option Base 1
Sub PoneFinMes()
CeldaFecha = "AF1" 'celda donde dejar la fecha como valor
'carga de matriz con los inicio de nombre de hoja
NomMeses = Array("ENE", "FEB", "MAR", "ABR", "MAY", "JUN", "JUL", "AGO", "SET", "OCT", "NOV", "DIC")
'revisa Hojas
For Each LaHoja In Sheets
For ElMes = 1 To UBound(NomMeses)
If UCase(Left(LaHoja.Name, 3)) = UCase(NomMeses(ElMes)) Then
If ElMes < Month(Date) Then LaHoja.Range(CeldaFecha).Value = DateSerial(2000 + Right(LaHoja.Name, 2), IIf(ElMes = 12, 12, ElMes + 1), IIf(ElMes = 12, 31, 0))
End If
Next
Next
End Sub
Como verás es bastante simple
Si quieres que se ejecute al abrir el libro, reemplaza tu código anterior por el siguiente:
' cuando llega al último día del mes, lo deja fijo y ya no se actualiza la fecha ' Private Sub Workbook_Open() Call PoneFinMes End Sub
Dado que estamos en Enero es complicado probarla pero hasta donde ví funciona OK.
.
.
Una aclaración que me quedó pendiente:
El procedimiento que te compartí coloca SIEMPRE el último día del mes que ya haya transcurrido.
Porque la solución
Day(celda + 1) = 1
es válida sólo si abres el archivo el último día de mes. Si ese día fuese durante un fin de semana o por cualquier razón no lo abrieses justo ese dia, nunca fijará la fecha, pues ya habrá pasado.
Por eso mi rutina, controla que esté colocado el último día del mes en aquellas hojas de los meses transcurridos.
Saludos
Fer
.