none
Días hábiles entre dos fechas RRS feed

  • Pregunta

  • Hola a todos.

    Alguién me podría decir como obtener los días hábiles entre dos fechas utilizando el calendario de tareas, en Microsoft Projecte utilizando VBA.

    Saludos y Gracias.

    martes, 16 de junio de 2015 16:22

Respuestas

  • Después de muchas búsquedas por internet logré cumplir mi objetivo el cálculo de días hábiles  en VBA de acuerdo al calendario de tareas de MicroSoft Project, Lo he probado en Microsoft Project 2010.

    En este caso cuando mando a llamar a la función, ya tengo abierto un archivo de project, por eso uso ActiveProject.Calendar. Pero sino lo tienen abierto el archivo, pueden utilizar las líneas que están en comentario.

    A continuación comparto con ustedes el código.

    Function workingDay(startDate, endDate) As Long
        Dim objMSProject As MSProject.Application
        Dim objMSProjectDoc As MSProject.Project
        Dim objMSProjectCal As Calendar
        Dim objMSProjectPeriod As Period
        Dim strProjectName As String
        Dim intWorkingDays As Integer
        
        Dim intCheckYear As Integer ' The year currently being checked
        Dim intCheckMonth As Integer ' The month currently being checked
        Dim intCheckDay As Integer ' The day currently being checked
        Dim intCounter As Integer ' Counter for the for/next loop
        Dim dteCurrentlyChecking As Date ' The date currently being checked


        intCheckYear = Year(startDate)
        intCheckMonth = Month(startDate)
        intCheckDay = Day(startDate)
        
        strProjectName = ActiveProject.Name
        'Set objMSProjectDoc = GetObject(strProjectName)
        'Set objMSProjectCal = objMSProjectDoc.Calendar
        Set objMSProjectCal = ActiveProject.Calendar
        intWorkingDays = 0

        With objMSProjectCal.Years(intCheckYear).Months(intCheckMonth) ' The year and month to check
            For intCounter = intCheckDay To .Days.Count '
                If .Days(intCounter).Working = True Then 'is a Working Day
                    dteCurrentlyChecking = DateSerial(intCheckYear, intCheckMonth, intCounter)
                    If dteCurrentlyChecking > endDate Then ' Check it is not past the end date
                        workingDay = intWorkingDays
                        GoTo funCalcWorkingDays_Exit ' Clean up before exiting
                    Else
                        intWorkingDays = intWorkingDays + 1
                    End If
                End If
            Next
        End With
        workingDay = intWorkingDays
    funCalcWorkingDays_Exit:     ' Close Project and Initialize Fields
        On Error Resume Next
        objMSProject.DocClose ' Close the project file
        objMSProject.Quit ' Quit MSP
        Exit Function ' End the function
        'workingDay = intWorkingDays
    End Function

    • Marcado como respuesta Asevilla miércoles, 17 de junio de 2015 23:19
    miércoles, 17 de junio de 2015 23:18