La ptite macro Excel du dimanche pour construire un planning

C‘est la deuxième « macro excel du dimanche » que je publie sur le blog. La première (macro excel pour reconstituer une BOM en niveau à partir de liens parents-fils) est de loin la page la plus visitée sur le blog et je souhaite un succès identique pour cette nouvelle Macro. Celle-ci est beaucoup moins orientée métier du PLM, elle m’aide plus à préparer des plannings pour les déploiements PLM.

La majorité du code est contenu dans un form VBA, il vous suffit de rajouter une macro d’ouverture du form et de rajouter un appel à cette macro depuis le ruban.

Vous pourrez alors ouvrir le formulaire

Définir la période de votre planning

Ajouter des ressources (j’ai ajouté la possibilité de les rentrer toutes d’un coup, séparées par un point virgule)

Et générer le planning

Après, libre à vous de remplir ce planning avec des valeurs, des couleurs,etc. Cela reste du excel, pas super flexible quand il faut décaler des choses dans le planning, mais bon ça me permet de donner une visibilité projet assez rapidement dans mes présentations.

Voici la vidéo de présentation

Le code de construction du planning (sur demande je pourrai rajouter des commentaires, après tout c’est une « macro du dimanche »)

   ' check if end date is greater than start date
    Dim test As Boolean
    test = False
    
    If (ComboYearStart.Value < ComboYearEnd.Value) Then
        test = True
    ElseIf (ComboYearStart.Value = ComboYearEnd.Value) Then
        If (ComboMonthStart.ListIndex <= ComboMonthEnd.ListIndex) Then
            test = True
        End If
    End If
    
    If (test = True) Then
    
        ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
        
        Dim startCol As Integer
        startCol = 3
        Dim startRow As Integer
        startRow = 4
        
        'main title
         
        Cells(1, 1) = "Planning"
        Cells(1, 1).Font.Bold = True
        Cells(1, 1).Font.Size = 24
        
        'days
        For i = 0 To 5
            Cells(startRow - 1, startCol + i * 7) = "mo"
            Cells(startRow - 1, startCol + 1 + i * 7) = "tu"
            Cells(startRow - 1, startCol + 2 + i * 7) = "we"
            Cells(startRow - 1, startCol + 3 + i * 7) = "th"
            Cells(startRow - 1, startCol + 4 + i * 7) = "fr"
            Cells(startRow - 1, startCol + 5 + i * 7) = "sa"
            Cells(startRow - 1, startCol + 6 + i * 7) = "su"
        Next
        
        Dim startMonth As Integer
        Dim startYear As Integer
        Dim endMonth As Integer
        Dim endYear As Integer
        startYear = ComboYearStart.Value
        startMonth = ComboMonthStart.ListIndex + 1
        endYear = ComboYearEnd.Value
        endMonth = ComboMonthEnd.ListIndex + 1
        
        Dim monthDiff As Integer
        If (endYear = startYear) Then
            monthDiff = endMonth - startMonth
        Else
            monthDiff = (13 - startMonth) + (endMonth) + (endYear - startYear - 1) * 12
        End If
        
        ' loop in months
        Dim monthIndex As Integer
        Dim yearIndex As Integer
        monthIndex = startMonth
        yearIndex = startYear
        
        months = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
        Dim rowIndex As Integer
        Dim colIndex As Integer
        Dim firstMondayIndex As Integer
        firstMondayIndex = 0
        rowIndex = startRow
        Dim mydte As Date
        
        Dim NbDayInMonth As Integer
        
        For i = 0 To monthDiff - 1
            
            'date analysis
            mydte = CDate("1/" + CStr(monthIndex) + "/" + CStr(yearIndex))
            NbDayInMonth = Day(DateSerial(Year(mydte), Month(mydte) + 1, 1) - 1)
            firstMondayIndex = ((7 - Weekday(DateSerial(Year(mydte), Month(mydte), 7))) + 2) Mod 7
            If (firstMondayIndex = 0) Then
            firstMondayIndex = 7
            End If
            
            Cells(rowIndex, startCol - 1) = months(monthIndex - 1) + " - " + CStr(yearIndex)
            Cells(rowIndex, startCol - 1).Font.Color = RGB(100, 100, 170)
            Cells(rowIndex, startCol - 1).Font.Bold = True
            'Listbox1 = ressource List
            For k = 1 To ListBox1.ListCount
                Cells(rowIndex + k, startCol - 1) = ListBox1.List(k - 1)
            Next
            
            If (firstMondayIndex = 1) Then
                colIndex = startCol
                Range(Cells(rowIndex, startCol + 41), Cells(rowIndex + ListBox1.ListCount + 1, startCol + NbDayInMonth)).Interior.Color = RGB(255, 255, 255)
            Else
                colIndex = 8 - firstMondayIndex + startCol
                Range(Cells(rowIndex, startCol), Cells(rowIndex + ListBox1.ListCount + 1, startCol + 7 - firstMondayIndex)).Interior.Color = RGB(255, 255, 255)
                Range(Cells(rowIndex, startCol + 41), Cells(rowIndex + ListBox1.ListCount + 1, startCol + 7 - firstMondayIndex + NbDayInMonth + 1)).Interior.Color = RGB(255, 255, 255)
            End If
            
            For j = 0 To NbDayInMonth - 1
                Cells(rowIndex, colIndex + j) = j + 1
                If (IsWeekend(CDate(CStr(j + 1) + "/" + CStr(monthIndex) + "/" + CStr(yearIndex))) = True) Then
                    Cells(rowIndex, colIndex + j).Interior.Color = RGB(200, 200, 200)
                    For k = 1 To ListBox1.ListCount + 1
                        Cells(rowIndex + k, colIndex + j).Interior.Color = RGB(200, 200, 200)
                    Next
                Else
                    Cells(rowIndex, colIndex + j).Interior.Color = RGB(200, 200, 255)
                End If
            Next
            
            rowIndex = rowIndex + ListBox1.ListCount + 2
            ' update monthIndex
            If (monthIndex = 12) Then
                monthIndex = 1
                yearIndex = yearIndex + 1
            Else
                monthIndex = monthIndex + 1
            End If
        Next
        
        'format columns
        Columns(1).ColumnWidth = 18
        Columns(2).ColumnWidth = 28
        Range(Cells(1, startCol), Cells(1, startCol + 43)).ColumnWidth = 2.71
    Else
        MsgBox ("The End date should be greated than the start date")
    End If

Cliquez ci-dessous pour télécharger les sources:

Générateur de Planning Excel (1868 téléchargements)