Calendrier - remplissage automatique

[jeremy_23]

Bonjour,

J'aimerais remettre en forme un planning annuel en un planning détaillé par mois, la difficulté étant que j'aimerais pouvoir automatiquement convertir ce planning et que chaque séparation par une virgule dans le planning annuel puisse faire ajouter une ligne dans le planning mensuel (1 onglet par mois).
voir fichier ci joint pour exemple
(j'ai plusieurs bases desquelles on peut partir)

Merci d'avance,

[mercatog]

Bonjour
Bon ce sont des opération élémentaires de copie, insertion...
Pour la séparation des listes de clients, utilise split (qui donne un tableau d'éléments)

Exemple à compléter selon le même principe

Code :

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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
Sub PlanningYear2Month()
Dim i As Integer, j As Integer
Dim Sh As Worksheet
Dim Mois As String
 
Application.ScreenUpdating = False
With Worksheets("PLANNING")
    'On parcours notre planning annuel sur la 3ème ligne avec un pas de 4
    For j = 1 To 45 Step 4
        'le mois est en ligne 3
        Mois = .Cells(3, j)
        'si la cellule n'est pas vide
        If Mois <> "" Then
            Application.DisplayAlerts = False
            On Error Resume Next
            'on supprime l'éventuelle feuille portant le nom de notre mois
            Worksheets(Mois).Delete
            On Error GoTo 0
            Application.DisplayAlerts = True
            'on ajoute une nouvelle à la fin du classeur
            Set Sh = Worksheets.Add(after:=Sheets(Sheets.Count))
            'on la renomme par notre mois
            Sh.Name = Mois
            'On copie les 3 colonnes correspondant au mois
            .Range(.Cells(3, j), .Cells(42, j + 2)).Copy Sh.Range("A1")
            'on appelle la sub Formaliser (qui permet de reformater la feuille selon le modèle choisi)
            Formaliser Sh
            Set Sh = Nothing
        End If
    Next j
End With
Worksheets("PLANNING").Activate
End Sub
 
Private Sub Formaliser(Sh As Worksheet)
Dim i As Integer, j As Integer
Dim k As Byte, n As Byte
Dim Cli As String
Dim Tb
Const NbC As Byte = 5                                      'Nombre max de clients par jour
 
Application.ScreenUpdating = False
With Sh
    'on enlève les bordures et supprime le fusionnement des cellules
    With .UsedRange
        .Borders.LineStyle = xlNone
        .UnMerge
    End With
    'on intervertit les colonnes 2 et 1
    .Columns(2).Copy
    .Columns(1).Insert
    .Columns(3).Delete
 
    'on parcour  les lignes d'en bas vers le haut
    For j = 40 To 3 Step -1
        'On insère NbC lignes vides
        .Rows(j + 1 & ":" & j + NbC - 1).Insert
        'bordures
        With .Range("A" & j & ":C" & j + NbC - 1)
            .Borders.LineStyle = 1
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
        'liste éventuelle des clients de la semaine i et de la journée j (par analogie)
        Cli = Replace(.Cells(j, 3), " ", "")
        'si notre liste est non vide
        If Cli <> "" Then
            'Tb est un tableau comportant tous les éléments séparés par ", "
            Tb = Split(Cli, ",")
            'n le nombre d'éléments de notre tableau -1 (le premier élément porte l'indice 0
            n = UBound(Tb)
            's'il y a plus d'un client
            If n <= NbC - 1 Then
                .Range(.Cells(j, 3), .Cells(j + n, 3)) = Application.Transpose(Tb)
            End If
        End If
    Next j
    k = 1
    For i = 7 * NbC + 3 To 38 * NbC + 3 Step 7 * NbC
        k = k + 3
        .Range("A" & i & ":C" & i + 7 * NbC - 1).Cut .Cells(3, k)
    Next i
    'on supprime la colonne des jours pour les semaines 2 à 4
    For i = 16 To 4 Step -3
        .Columns(i).Delete
    Next i
 
    'première petite mise en page
    .Rows(2).Delete
    .UsedRange.ColumnWidth = 24
    With .Range("A:B,D:D,F:F,H:H,J:J,L:L")
        .ColumnWidth = 3
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
    End With
End With
End Sub