Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » Primer dia del calendario

Excel - Primer dia del calendario

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil
Val: 18
Ha disminuido su posición en 3 puestos en Excel (en relación al último mes)
Gráfica de Excel

Primer dia del calendario

Publicado por Luis (13 intervenciones) el 18/01/2019 09:59:26
Buenos días.

Me he atascado en el cuadrante que estoy modificando desde hace unos días. Mis compañeros me pidieron que modificara el programa, para que en la hoja anual, el calendario pasara de ser lineal y estático a un calendario como aparece en una hoja de un calendario típico, colocando el primer día del mes en el día de la semana correspondiente. eso lo he conseguido con formulas matriciales.

El problema es en las hojas de los meses (enero, febrero....) también han pasado a ser dinámicos, antes el 1º día del mes estaba en la columna 8ª, ahora puede estar entre la 8 y la 14, al lanzar el formulario "ART_15_4" que tiene asociado la macro "función" no locro que funcione.


Lo que hacia básicamente era colocar el cursor en la fila del trabajador que queramos meter un absentismo y la columna donde quiero que empiece a poner el absentismos, ejecutar el formulario "ART15_4" y este coloca el concepto las veces que dice el convenio, saltando al mes siguiente si es necesario.


Pero no locro que funcione ahora.


Subo un archivo, con los primeros cuatro meses, para que no pese mucho.


Gracias por vuestra ayuda.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Primer dia del calendario

Publicado por Antoni Masana (2486 intervenciones) el 18/01/2019 11:12:53
Te he corregido unas cuantas cosas.

Modulo FUNCION ( Te remarco lo que he modificado para que funcione )

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Function MarcarAgenda(Días As Integer, Tipo As String, Texto As String) As Integer
    Dim Meses(12) As String
    Dim Fecha, Fecha_Ini As Date
    Dim fila As Long
    Dim columna, Ini_mes As Integer, Activa_Fil As Long, Activa_Col As Long
 
    Activa_Fil = ActiveCell.Row
    Activa_Col = ActiveCell.Column
 
    ' --- Tipo="N" Días naturales

    ' --- Tipo="H" Días de hábiles

 
    MarcarAgenda = 0
    For x = 1 To 12: Meses(x) = UCase(MonthName(x)): Next
 
    Día = Cells(2, ActiveCell.Column)
    Fecha = Cells(2, ActiveCell.Column)
 
    Range("H1:AR1").Select  ' SELECCIONA LAS CELDAS CON FECHA

 
    ' ---&--- Encuenta en primer dia del mes

 
    Col = 8
    While Day(Cells(2, Col)) <> 1: Col = Col + 1: Wend
    Fecha_Ini = Cells(2, Col)
 
 
    For x = 1 To 13
        If [B1] = Meses(x) Then Exit For
    Next
 
    If x = 13 Then
       MsgBox "Mes inválido"
       MarcarAgenda = 1
       Exit Function
    End If
 
    año = [A1]
    mes = x
    Fecha = Día  ' CDate(día & "/" & mes & "/" & año) ' los días del mes eran números, ahora son fechas reales

 
    Do Until Días = 0
       hoja = Meses(Month(Fecha))
       columna = Day(Fecha) + 8 ' 8 es la columna donde empezaba el mes ahora puede empezar en columna 8 al 15

 
       If Tipo = "N" Then 'Días naturales

          Sheets(hoja).Cells(Activa_Fil, columna) = Texto
          Fecha = Fecha + 1
          columna = columna + 1
          Días = Días - 1
       ElseIf Tipo = "H" Then 'Días hábiles

          If Not Sheets(hoja).Cells(Activa_Fil, columna) = "L" Then
             Sheets(hoja).Cells(Activa_Fil, columna) = Texto
             Días = Días - 1
          End If
          Fecha = Fecha + 1
          columna = columna + 1
       Else
          MsgBox "Tipo de día inválido"
          MarcarAgenda = 1
          Exit Function
       End If
    Loop
    Cells(Activa_Fil, Activa_Col).Select
    Exit Function
 
ErrorIndeterminado:
       MarcarAgenda = 999
End Function


Modulo 1

1
2
3
Sub ABSENTISMO()
    ART15_4.Show
End Sub

Art15_4 - Código:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Private Sub CERRAR_Click()
    Unload Me
End Sub
 
Private Sub FUERA_Click()
    ' --- Desproteger Hoja

    ActiveSheet.Unprotect Password:="yorki"
 
    If art_a.Value = True Then rc = MarcarAgenda(15, "N", "15.4.A")
    If art_b.Value = True Then rc = MarcarAgenda(3, "N", "15.4.B")
    If art_c.Value = True Then rc = MarcarAgenda(12, "H", "15.4.C")
    If art_d.Value = True Then rc = MarcarAgenda(30, "N", "15.4.D")
    If art_e.Value = True Then rc = MarcarAgenda(7, "H", "15.4.E")
    If art_f.Value = True Then rc = MarcarAgenda(5, "H", "15.4.F")
    If art_h.Value = True Then rc = MarcarAgenda(1, "N", "15.4.H")
    If art_i.Value = True Then rc = MarcarAgenda(2, "H", "15.4.I")
    If Art_j.Value = True Then rc = MarcarAgenda(1, "N", "15.4.J")
    If art_k.Value = True Then rc = MarcarAgenda(1, "N", "15.4.K")
    If art_l.Value = True Then rc = MarcarAgenda(1, "N", "15.4.L")
 
    If rc > 0 Then MsgBox "Error en la asignación de días. Error " & rc
 
    ' --- Proteger Hoja

    ActiveSheet.Protect Password:="yorki"
End Sub
 
Private Sub madrid_Click()
    ' --- Desproteger Hoja

    ActiveSheet.Unprotect Password:="yorki"
 
    If art_a.Value = True Then rc = MarcarAgenda(15, "N", "15.4.A")
    If art_b.Value = True Then rc = MarcarAgenda(1, "N", "15.4.B")
    If art_c.Value = True Then rc = MarcarAgenda(10, "H", "15.4.C")
    If art_d.Value = True Then rc = MarcarAgenda(30, "N", "15.4.D")
    If art_e.Value = True Then rc = MarcarAgenda(5, "H", "15.4.E")
    If art_f.Value = True Then rc = MarcarAgenda(3, "H", "15.4.F")
    If art_h.Value = True Then rc = MarcarAgenda(1, "N", "15.4.H")
    If art_i.Value = True Then rc = MarcarAgenda(1, "N", "15.4.I")
    If Art_j.Value = True Then rc = MarcarAgenda(1, "N", "15.4.j")
    If art_k.Value = True Then rc = MarcarAgenda(1, "N", "15.4.K")
    If art_l.Value = True Then rc = MarcarAgenda(1, "N", "15.4.L")
 
    If rc > 0 Then MsgBox "Error en la asignación de días. Error " & rc
 
    ' --- Proteger Hoja

    ActiveSheet.Protect Password:="yorki"
End Sub

Adjunto Libro.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar