---
title: "La ptite macro Excel du dimanche pour construire un planning"
date: 2016-04-24
categories: 
  - "excel"
  - "plm"
coverImage: "planning.jpg"
---

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)](http://plm-ouvert.fr/2013/10/la-ptite-macro-excel-du-dimanche-pour-reconstruire-une-nomenclature/) 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

![ribbon](images/ribbon.jpg)

Définir la période de votre planning

![form1](images/form1.jpg)

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

![ressources](images/ressources.jpg)

Et générer le planning

![planning](images/planning.jpg)

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.

![filledplanning](images/filledplanning.jpg)

Voici la vidéo de présentation

https://youtu.be/x7K6aQc2Wa4

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

\[code lang="vb"\] ' check if end date is greater than start date Dim test As Boolean test = False If (ComboYearStart.Value &lt; ComboYearEnd.Value) Then test = True ElseIf (ComboYearStart.Value = ComboYearEnd.Value) Then If (ComboMonthStart.ListIndex &lt;= 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 \[/code\]

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

\[download id="2205"\]
