Sombrear celdas entre fecha y fecha

[fuipil]

Bueno días,

Agradezco la información que aporta el foro de forma tan profesional. Está siendo de gran ayuda a todos.

Mi problema para completar mi trabajo es el siguiente:

Cuando selecciono la fecha de entrada y la fecha de salida en el formulario se registran todos los datos correctamente pero vinculo dichas fechas en un "Informe" calendario que se puede visualizar "a modo de impresión".

En dicho "Informe" sólo puedo sombrear la fecha de entrada "ARR" pero no logro sombrear todas las fechas posteriores hasta la fecha salida que he marcado en el formulario.

Pueden ayudarme, por favor??

Adjunto archivo y gracias de antemano.

pruebav1.rar

[joshua]

Saludos.

Podrias ser un poco mas grafico del resultado que quieres obtener.

Atte.

joshua

[fuipil]

Muchas gracias por tu pronta respuesta.

Te envío un gráfico en el que en 3 pasos te muestro lo que necesito.

Creo que es sencillo pero no doy con la forma.

Gracias de nuevo.

ver paso a paso.pdf

[joshua]

Saludos.

Prueba con tu macro ya modificada.

Private Sub btn_AceptarPlanin_Click()

    Dim hoja As Worksheet
    'modificaciones
    '////
    Dim fecha, cel1, cel2 As String
   '////
    Dim elegido As Long
    Dim mes As Integer
    Dim año As Integer
    Dim semana As Variant
    Dim diamax As Integer
    Dim dia1 As Integer
    Dim diasem As String
    Dim final As Long
    Dim hoja2 As Worksheet
    Dim ultfila As Long
    Dim x As Long
    Dim y As Long
    Dim dia2, dia3 As Long

    Set hoja = Sheets("Planin")
    Set hoja2 = Sheets("BBDD")

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False

    If cb_Mes.Value = "ENERO" Then elegido = 1
    If cb_Mes.Value = "FEBRERO" Then elegido = 2
    If cb_Mes.Value = "MARZO" Then elegido = 3
    If cb_Mes.Value = "ABRIL" Then elegido = 4
    If cb_Mes.Value = "MAYO" Then elegido = 5
    If cb_Mes.Value = "JUNIO" Then elegido = 6
    If cb_Mes.Value = "JULIO" Then elegido = 7
    If cb_Mes.Value = "AGOSTO" Then elegido = 8
    If cb_Mes.Value = "SEPTIEMBRE" Then elegido = 9
    If cb_Mes.Value = "OCTUBRE" Then elegido = 10
    If cb_Mes.Value = "NOVIEMBRE" Then elegido = 11
    If cb_Mes.Value = "DICIEMBRE" Then elegido = 12

    hoja.Activate
    ActiveSheet.Unprotect ("xxxxx")
    Range("a3").Activate

    fecha = "01/" & elegido & "/" & txt_Año
    fecha = Format(fecha, "yyyy/mm/dd")
    ActiveCell.Value = fecha
    'Sheets("Planin").Range("a3").Value = fecha

'===========================================================================
'== Elaboramos el calendario de la hoja Planin en relación al mes elegido ==
'===========================================================================

    mes = Month(hoja.Range("a3"))
    año = Year(hoja.Range("a3"))
    semana = Array("L", "M", "X", "J", "V", "S", "D")

        Select Case mes
        Case 1, 3, 5, 7, 8, 10, 12
            diamax = 31
        Case 2
            If Month(DateSerial(año, mes, 29)) <> 2 Then
                diamax = 28
            Else
                diamax = 29
            End If
        Case Else
            diamax = 30
        End Select

    hoja.Range("b3:af4").ClearContents

    For dia1 = 1 To diamax
            hoja.Cells(3, dia1 + 1).Value = dia1
            diasem = Weekday(DateSerial(año, mes, dia1), vbMonday)
            hoja.Cells(4, dia1 + 1).Value = semana(diasem - 1)
    Next dia1

    hoja.Range("a1").Value = UCase(Format(hoja.Range("a3").Value, _
        "MMMM - yyyy"))

'==============================
'== Limpiamos la hoja Planin ==
'==============================

    final = hoja.Range("a6").End(xlDown).Row
    hoja.Range("B6:af" & final).Interior.Pattern = xlNone
    hoja.Range("B6:af" & final).Interior.TintAndShade = 0
    hoja.Range("B6:af" & final).Interior.PatternTintAndShade = 0

'=============================================
'== Sombreamos la hoja Planin en función de ==
'==  las fechas de la BBDD el mes elegido  ==
'=============================================

    ultfila = hoja2.Cells(65536, 2).End(xlUp).Row
    fecha = hoja.Range("a3").Value

    For x = 2 To ultfila
        For y = 6 To 21
            If Month(hoja2.Cells(x, 3)) = Month(fecha) And _
                Year(hoja2.Cells(x, 3)) = Year(fecha) And _
                hoja2.Cells(x, 5) = hoja.Cells(y, 1) Then
                    dia2 = Day(hoja2.Cells(x, 3))
                    'modificaciones
                    '////////
                    '*hoja.Cells(y, dia2 + 1).Interior.ColorIndex = 23
                    dia3 = Day(hoja2.Cells(x, 4))
                    'Sheets("Planin").Cells(y, dia2 + 1).Interior.ColorIndex = 23
                    cel1 = hoja.Cells(y, dia2 + 1).Address
                    cel2 = hoja.Cells(y, dia3 + 1).Address
                    hoja.Range(cel1 & ":" & cel2).Interior.ColorIndex = 23
                    '/////////
            End If
        Next y
    Next x

' Cerramos el formulario
    Unload Me

'=========================================
'== Abrimos una vista previa del Planin ==
'=========================================

'    Sheets("Planin").Visible = True
    hoja.Activate
    ActiveWindow.SelectedSheets.PrintPreview
    ActiveSheet.Protect ("xxxxx")
'    Sheets("Planin").Visible = False
    Sheets("Menu").Select

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    Application.CutCopyMode = False

End Sub
[/HTML]

Atte.

joshua

[fuipil]

Muchas gracias Joshua

Creo que ahora puedo continuar y el código ES ESTABLE Y FUNCIONA.

Déjeme probar durante la jornada de hoy y mañana le envío un mensaje.

Muy profesional y muy agradecido por su ayuda. A usted y a este foro.

Mañana conecto con usted de nuevo.

[fuipil]

Buenas noches Joshua

He probado el codigo y funciona perfectamente

podemos dar por resuelta la consulta. Murchas gracias por la ayuda tan profesional. A ustedy atodo el foro.

TEMA SOLUCIONADO