Poner marca en el día actual en un calendario
Dispongo de un planning creado por mi entre los Rangos D5;AS28, quisiera que al abrir la hoja los bordes del día correspondiente a la fecha actual, se remarcaran de un color de forma que al mirar en conjunto el planning claramente se aprecie el día en el que estamos. Confío en haberlo explicado correctamente.
2 Respuestas
En el evento para abrir ula hoja en Excel toca:
Hacer for que recorra toda la matriz
Hacer un condicional que valide cada celda validada en donde si es igual a la fecha de hoy con la (función Isdate("Fecha de hoy") al retornar true o 1 haga lo siguiente:
Cells(Fila, columna). Interior.colorIndex=VbYellow ' si queremos relleno de 'color amarillo
Espero haber sido claro o sino me comentas para poderle colaborar más
Saludos!
Att. Hernán Camilo Martínez
Bogotá D.C - Colombia.
Te agradezco la rapidez en la contestación, discúlpame pero he olvidado decir que no tengo ni idea de programación.. La verdad es que no se como empezar la macro. ¿Si me puedes dar una idea...? Muchas gracias.
Pues mi correo es [email protected] para que me envíes la macro
- Compartir respuesta
H o l a:
Pon la siguiente macro en los eventos de Thisworkbook:
Private Sub Workbook_Open() 'Por.Dante Amor Set h = Sheets("Hoja5") Set r = h.Range("D5:AS28") Set b = r.Find(Date, lookat:=xlWhole) ' r.Borders(xlInsideVertical).LineStyle = xlNone r.Borders(xlInsideHorizontal).LineStyle = xlNone ' If Not b Is Nothing Then b.Borders(xlEdgeLeft).LineStyle = xlContinuous b.Borders(xlEdgeLeft).ColorIndex = 5 b.Borders(xlEdgeLeft).Weight = xlMedium b.Borders(xlEdgeTop).LineStyle = xlContinuous b.Borders(xlEdgeTop).ColorIndex = 5 b.Borders(xlEdgeTop).Weight = xlMedium b.Borders(xlEdgeRight).LineStyle = xlContinuous b.Borders(xlEdgeRight).ColorIndex = 5 b.Borders(xlEdgeRight).Weight = xlMedium b.Borders(xlEdgeBottom).LineStyle = xlContinuous b.Borders(xlEdgeBottom).ColorIndex = 5 b.Borders(xlEdgeBottom).Weight = xlMedium End If h.Select End Sub
Instrucciones para poner la macro en los eventos ThisWorkbook
- Abre tu libro de excel
- Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
- Del lado izquierdo dice: VBAProject, abajo dale doble click a ThisWorkbook
- Del lado derecho copia la macro
[code]‘
‘S aludos. Dante Amor. R ecuerda valorar la respuesta.
H o l a:
Después de copiar la macro, cambia en la macro "Hoja5" por el nombre de tu hoja en donde tienes el "planning", guarda el archivo como libro de excel habilitado para macros, cierra el archivo y vuelve a abrir el archivo.
Si al abrir el libro te aparece un mensaje para habilitar las macros, presiona Aceptar.
En la hoja de planning aparecerá con bordes el día de hoy.
Avísame si tienes dudas.
[code]S aludos. Dante Amor. R ecuerda valorar la respuesta.
Muchas gracias por tu macro, pero me surge una cuestión en ThisWorkbook tengo esta otra macro y la verdad no se muy bien como combinar las dos.
Sub Workbook_Open() 'Ajustada x Elsamatilde ' con esta macro ponemos una fecha a partir de la cual aparecera una peticion de ' licencia de uso para poder abrir el libro no pudiendo hacer nada mas que introducir ' correctamente la clave If Date <= DateSerial(2016, 1, 13) Then GoTo sigo Application.EnableCancelKey = xlErrorHandler On Error GoTo Ver_Error licenciauso = InputBox("Introducir la licencia de uso") If licenciauso <> "furilo" Then MsgBox "Clave incorrecta; VUELVA A INTRODUCIR LA CLAVE" licenciauso2 = InputBox("licencia de uso 2ª oportunidad") If licenciauso2 <> "furilo" Then MsgBox "Clave incorrecta; ULTIMA OPORTUNIDAD PARA INTRODUCIR LA CLAVE" licenciauso3 = InputBox("licencia de uso 3ª y Ultima oportunidad") If licenciauso3 <> "furilo" Then Application.DisplayAlerts = False ActiveWorkbook.Close Exit Sub Else GoTo sigo End If Else GoTo sigo End If End If sigo: Application.ScreenUpdating = False 'muestra solo las hojas cuyos nombres aparecen For Each sh In Sheets ' con este bucle aparecen las hojas que he elegido que aparezcan If sh.Name = "PLANNING" Or sh.Name = "CALENDARIO" Or sh.Name = "AGENDA" Or sh.Name = "DIASTRABAJO" Then sh.Visible = True ' sh.Visible = True este bucle haria que aparecieran todas las hojas no solo las de arriba Next sh Sheets("PORTADA").Visible = xlSheetVeryHidden Exit Sub Ver_Error: Application.DisplayAlerts = False ActiveWorkbook.Close End Sub
Te anexo la macro integrada, la celda quedará con un borde azul
Sub Workbook_Open() 'Ajustada x Elsamatilde ' Con esta macro ponemos una fecha a partir de la cual aparecera una peticion de ' licencia de uso para poder abrir el libro no pudiendo hacer nada mas que introducir ' correctamente la clave If Date <= DateSerial(2016, 1, 13) Then GoTo sigo Application.EnableCancelKey = xlErrorHandler On Error GoTo Ver_Error licenciauso = InputBox("Introducir la licencia de uso") If licenciauso <> "furilo" Then MsgBox "Clave incorrecta; VUELVA A INTRODUCIR LA CLAVE" licenciauso2 = InputBox("licencia de uso 2ª oportunidad") If licenciauso2 <> "furilo" Then MsgBox "Clave incorrecta; ULTIMA OPORTUNIDAD PARA INTRODUCIR LA CLAVE" licenciauso3 = InputBox("licencia de uso 3ª y Ultima oportunidad") If licenciauso3 <> "furilo" Then Application.DisplayAlerts = False ActiveWorkbook.Close Exit Sub Else GoTo sigo End If Else GoTo sigo End If End If sigo: Application.ScreenUpdating = False 'muestra solo las hojas cuyos nombres aparecen For Each sh In Sheets ' con este bucle aparecen las hojas que he elegido que aparezcan If sh.Name = "PLANNING" Or sh.Name = "CALENDARIO" Or _ sh.Name = "AGENDA" Or sh.Name = "DIASTRABAJO" Then sh.Visible = True ' sh.Visible = True este bucle haria que aparecieran todas las hojas no solo las de arriba Next sh Sheets("PORTADA").Visible = xlSheetVeryHidden ' 'Ini.Por.Dante Amor Set h = Sheets("PLANNING") Set r = h.Range("D5:AS28") Set b = r.Find(Date, lookat:=xlWhole) ' r.Borders(xlInsideVertical).LineStyle = xlNone r.Borders(xlInsideHorizontal).LineStyle = xlNone ' If Not b Is Nothing Then b.Borders(xlEdgeLeft).LineStyle = xlContinuous b.Borders(xlEdgeLeft).ColorIndex = 5 b.Borders(xlEdgeLeft).Weight = xlMedium b.Borders(xlEdgeTop).LineStyle = xlContinuous b.Borders(xlEdgeTop).ColorIndex = 5 b.Borders(xlEdgeTop).Weight = xlMedium b.Borders(xlEdgeRight).LineStyle = xlContinuous b.Borders(xlEdgeRight).ColorIndex = 5 b.Borders(xlEdgeRight).Weight = xlMedium b.Borders(xlEdgeBottom).LineStyle = xlContinuous b.Borders(xlEdgeBottom).ColorIndex = 5 b.Borders(xlEdgeBottom).Weight = xlMedium End If h.Select ' 'Fin.Por.Dante Amor Exit Sub Ver_Error: Application.DisplayAlerts = False ActiveWorkbook.Close End Sub
':) 'S aludos. D a n t e A m o r . R ecuerda valorar la respuesta. G racias ':)R ecuerda valorar la respuesta. G r a c i a s
Perdona que te moleste tanto pero la macro no me funciona, es decir, la parte en la que debería marcarme el día en que estamos, pues no hace nada, no pone ninguna marca. Saludos.
No es ninguna molestia, envíame tu archivo con la macro para revisarla.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “juan carlos bp” y el título de esta pregunta.
Avísame en esta pregunta cuando me lo hayas enviado.
‘
':)
S a l u d o s . D a n t e A m o r
H ol a:
Te anexo la macro actualizada
Sub Workbook_Open() 'Ajustada x Elsamatilde ' Con esta macro ponemos una fecha a partir de la cual aparecera una peticion de ' licencia de uso para poder abrir el libro no pudiendo hacer nada mas que introducir ' correctamente la clave If Date <= DateSerial(2016, 1, 13) Then GoTo sigo Application.EnableCancelKey = xlErrorHandler On Error GoTo Ver_Error licenciauso = InputBox("Introducir la licencia de uso") If licenciauso <> "furilo" Then MsgBox "Clave incorrecta; VUELVA A INTRODUCIR LA CLAVE" licenciauso2 = InputBox("licencia de uso 2ª oportunidad") If licenciauso2 <> "furilo" Then MsgBox "Clave incorrecta; ULTIMA OPORTUNIDAD PARA INTRODUCIR LA CLAVE" licenciauso3 = InputBox("licencia de uso 3ª y Ultima oportunidad") If licenciauso3 <> "furilo" Then Application.DisplayAlerts = False ActiveWorkbook.Close Exit Sub Else GoTo sigo End If Else GoTo sigo End If End If sigo: Application.ScreenUpdating = False 'muestra solo las hojas cuyos nombres aparecen For Each sh In Sheets ' con este bucle aparecen las hojas que he elegido que aparezcan If sh.Name = "PLANNING" Or sh.Name = "CALENDARIO" Or _ sh.Name = "AGENDA" Or sh.Name = "DIASTRABAJO" Then sh.Visible = True ' sh.Visible = True este bucle haria que aparecieran todas las hojas no solo las de arriba Next sh Sheets("PORTADA").Visible = xlSheetVeryHidden ' 'Ini.Por.Dante Amor Set h = Sheets("PLANNING") Set r = h.Range("D5:AS28") mes = Format(Date, "mmmm") For i = 5 To 27 If Format(h.Cells(i, "C"), "mmmm") = mes Then For j = 4 To Columns("AS").Column If h.Cells(i, j) <> "" Then If Day(h.Cells(i, j)) = Day(Date) Then Set b = h.Cells(i, j) Exit For End If End If Next Exit For End If Next ' r.Borders(xlInsideVertical).LineStyle = xlNone r.Borders(xlInsideHorizontal).LineStyle = xlNone ' If Not b Is Nothing Then b.Borders(xlEdgeLeft).LineStyle = xlContinuous b.Borders(xlEdgeLeft).ColorIndex = 5 b.Borders(xlEdgeLeft).Weight = xlMedium b.Borders(xlEdgeTop).LineStyle = xlContinuous b.Borders(xlEdgeTop).ColorIndex = 5 b.Borders(xlEdgeTop).Weight = xlMedium b.Borders(xlEdgeRight).LineStyle = xlContinuous b.Borders(xlEdgeRight).ColorIndex = 5 b.Borders(xlEdgeRight).Weight = xlMedium b.Borders(xlEdgeBottom).LineStyle = xlContinuous b.Borders(xlEdgeBottom).ColorIndex = 5 b.Borders(xlEdgeBottom).Weight = xlMedium End If h.Select ' 'Fin.Por.Dante Amor Exit Sub Ver_Error: Application.DisplayAlerts = False ActiveWorkbook.Close End Sub
':) 'S aludos. D a n t e A m o r . R ecuerda valorar la respuesta. G racias ':)
- Compartir respuesta