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

Respuesta
1

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

Si desea mándame la Hoja de calculo al email hecamava (arroba)gmail.com

Me envía su correo electrónico para poder enviarle la macro, ¿cuándo la termine?

Gracias!.

Att. Hernán Camilo Martínez

Bogotá D.C - Colombia.

Ó el código es el siguiente

Private Sub Workbook_Open()

Dim i, j As Integer

For i = 5 To 28

    For j = 4 To 45
            If Cells(i, j) = Date Then
              Cells(i, j).Interior.ColorIndex = 41

            End If
     Next j

   Next i

End Sub

Por favor valorar la respuesta... Éxitos!.

Respuesta
1

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

  1. Abre tu libro de excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. Del lado izquierdo dice: VBAProject, abajo dale doble click a ThisWorkbook
  4. 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

Ok ya te mande el archivo.

saludos.

 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
':)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas