macro vba pour remplir un planning excel

**darkvadave** · 21/12/2011, 23h13

Bonsoir,
dans un planning d'une seule colone, je cherche à remplir les cases à partir d'une semaine type placée juste au-dessus (par exemple, lundi mardi mercredi et vendredi sont travaillés et colorés en vert avec écrit "prs" ; jeudi , non travaillé, est rouge avec écrit "abs"). Mon problème, c'est de faire un copier-coller qui ne concerne que la valaur, la couleur de police, la couleur de remplissage... mais pas le format (MFC...) ni les bordures... : en effet, les MFC qui permettent de visualiser les WE et jours fériés seraient effacées avec un copier-coller classique et les bordurent du planning seraient modifiées.
J'ai déjà une solution permettant une saisie à partir d'une liste via une commandbar, mais je n'arrive pas à en extraire une macro globale qui permettrait de remplir le planning d'un coup.
Merci d'avance.

**Kaera** · 22/12/2011, 07h33

Salut darkvadave,

Mon problème, c'est de faire un copier-coller qui ne concerne que la valaur, la couleur de police, la couleur de remplissage... mais pas le format (MFC...) ni les bordures... : en effet, les MFC qui permettent de visualiser les WE et jours fériés seraient effacées avec un copier-coller classique et les bordurent du planning seraient modifiées.

Un peu embrouillée là... Ton copier-coller doit ou bien ne doit pas comporter le format MFC et les bordures ?

Par ailleurs, peux-tu mettre un tout piti fichier exemple s'il te plaît ?
Juste pour être sûre du résultat que tu attends.

Kaera*

**ZebreLoup** · 22/12/2011, 10h13

Je ne suis pas sûr d'avoir bien compris ce que tu veux faire exactement. Tu as une liste de date et tu veux les mettre en forme en fonction du jour de la semaine ?

**darkvadave** · 22/12/2011, 14h39

Bonjour,
merci de vous intéresser à ce problème. En fait, j'aivais déjà posté une question intitulée "saisie d'un planning : comman bare de coloriage", sans trop de succès avec une question un peu plus étoffée et un planning simplifié en pièce jointe.
Je joins donc ce planning (les questions sont inscrites en commentaire en A1).
Merci d'avance.

**ZebreLoup** · 22/12/2011, 16h43

Alors on va y aller par étapes :

Tout d'abord, évite les On Error Resume Next un peu partout. Ca doit seulement servir à gérer une erreur à laquelle on s'attend et il faut bien remettre On Error GoTo 0 ensuite.

Pour créer une barre de coloriage, ton code est correct, le seul problème est qu'on ne peut pas créer 2 barres d'outils qui ont le même nom.
Il faudrait d'abord boucler sur les barres d'outils pour les effacer.

On met dans un module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
Private Sub AjoutBarreColoriage1()
    Dim cb As CommandBar
    Dim i As Integer
    Dim rg As Range
 
    For Each cb In Application.CommandBars
        If cb.Name = "BarreColoriage" Then cb.Delete
    Next cb
 
    With CommandBars.Add(Name:="BarreColoriage")
        .Visible = True
        .Protection = msoBarNoCustomize
 
        Set rg = Range("couleurs")
 
        For i = 1 To rg.Count
            With .Controls.Add(Type:=msoControlButton)
                .Style = msoButtonCaption
                .Tag = i
                .OnAction = "'Coloriage """ & i & """'"
                .Caption = rg.Cells(1, i).Value
            End With
        Next i
    End With
End Sub
Private Sub AjoutBarreColoriage2()
    Dim cb As CommandBar
    Dim i As Integer
    Dim rg As Range
 
    For Each cb In Application.CommandBars
        If cb.Name = "BarreColoriage2" Then cb.Delete
    Next cb
 
    With CommandBars.Add(Name:="BarreColoriage2")
        .Visible = True
        .Protection = msoBarNoCustomize
 
        Set rg = Range("couleurs")
 
        For i = 1 To rg.Count
            With .Controls.Add(Type:=msoControlButton)
                .Style = msoButtonCaption
                .Tag = i
                .OnAction = "'Coloriage """ & i & """'"
                .Caption = rg.Cells(1, i).Value
            End With
        Next i
    End With
End Sub

Et dans ThisWorkbook, on met

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub Workbook_Open()
    AjoutBarreColoriage1
    AjoutBarreColoriage2
End Sub

Ensuite, pour la saisie rapide, on peut appliquer le code suivant une fois les cellules selectionnées. Les zones sont à adapter et peuvent être nommées.

Pour faire la même chose sur une plage de date, c'est le même principe mais ça va dépendre du format définitif de ton classeur complet.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Sub AjusterFormatSelection()
    Dim sel As Range
    Dim c As Range
    Dim numJour As Integer
    Dim cModel As Range
 
    Set sel = Intersect(Selection, Feuil2.Range("G10:J35")) 'A adapter
 
    If sel.Count = 0 Then Exit Sub
 
    For Each c In sel
        numJour = Feuil2.Cells(c.Row, "B").Value
        If numJour < 1 Or numJour > 7 Then Exit Sub
 
        cModel = Feuil2.Range("P6:P12").Cells(numJour, 2)
 
        c.Value = cModel.Value 'On recopie la valeur
        recopierFormat cModel, c 'On recopie le format
    Next c
End Sub
 
Private Sub recopierFormat(cellModele As Range, cellCible As Range)
    'On ne travaille que sur une cellule
    If cell1.Count > 1 Or cell2.Count > 1 Then Exit Sub
 
    'Copie
    cellCible.Interior.ColorIndex = cellModele.Interior.ColorIndex
    cellCible.Font.ColorIndex = cellModele.Font.ColorIndex
    cellCible.Font.FontStyle = cellModele.Font.FontStyle
    cellCible.Font.Name = cellModele.Font.Name
    cellCible.Font.Size = cellModele.Font.Size
    cellCible.Font.Underline = cellModele.Font.Underline
End Sub

Pour ce qui est de la lenteur, soit tu passes le classeur en calcul manuel dans les options d'Excel, soit à chaque fois, tu fais au début des procédures:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Calculation = xlCalculationManual

Et à la fin :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Calculation = xlCalculationAutomatic

Pour le dernier point, je ne pense pas que ce soit possible. Il va falloir faire avec une image comme tu le suggérais.

Pour finir, je reviens sur une question de conception. Etant donné que la mise en forme à l'air d'être toujours associée au même contenu. Pourquoi ne pas uniquement travailler sur le contenu et ajouter juste une procédure globale qui fait la mise en forme (vu qu'il y a sans doute trop de possibilités pour faire de la MFC) et qui est lancée au moment opportun ?
Ça simplifiera beaucoup tes formules de calculs et la plupart des macros.

**darkvadave** · 27/12/2011, 00h18

Bonsoir ZebreLoup,
merci pour toutes ces infos (il me faut un peu de temps pour les décortiquer).
Pour le pb de lenteur, je l'ai réglé en cochant calcul sur ordre en option (je suis tombé dessus par hasard il y a qq jours, mais n'avais pas enlevé la question à ce sujet), du coup, le coloriage et très rapide et le calcul final ne prend que 2 s à 3 s.
Pour les MFC, c'est sûr qu'elles sont un peu lourdes, mais j'y suis arrivé. En fait, je n'ai pas toujours la même : j'ai fais un planning d'un mois de 31 j (que je multiplierai par 12 une fois au point) distinguant matins et apm (donc 62 lignes), et il faut bien qu'il y ait une gestion différente du 1er jour du mois, de même pour les fin de mois. Ensuite, je repère les sam apm,les dimanches, les JF (plus d'éventuels jours chômés lors des ponts). C'est après que ça se corse : en fait, j'ai des colones de comptages à droite du tableau pour gérer les erreurs de saisie du planning (par ex., on veut repérer si 2 personnes sont mises de garde de nuit le même jour ou savoir si le bon nombre de personnes est programmé le samedi matin : vert si ok/rouge si problème). En outre, un fond jaune pale est appliqué si la case n'a pas d'intérêt (ex : seules les lignes correspondant au samedi matin sont mises en évidence dans le colone de comptage des samedis matin). Bref, j'ai parfois été arrêté par le nb de caractères autaurisés dans la progrmmation des MFC et ça fait tout de suite fouillis quand j'essaie de l'expliquer.
Ceci dit, s'il y a moyen de simplifier, je suis preneur : je posterai à nouveau quand j'aurai intégré les macros que tu m'as envoyées.
Merci beaucoup.

Bonsoir ZebreLoup,
tout d'abord, jespère que tu as passé un bon Noël.
J'ai essayé le code pour les barres de coloriage, mais ça ne fonctionnes pas.
J'imagine que la boucle de départ sert à éviter d'avoir des barres de coloriage qui s'ajoutent les unes aux autres quand on ouvre plusieurs fois le fichier.
Pour l'appel des macro dans ThisWorkbook, ça ne fonctionne pas non plus ; par contre, ça marche pour lancer des macros (autres que AjoutBarreColoriage1 et AjoutBarreColoriage2 si on modifie le nom de la macro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Private Sub Workbook_Open()

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Private Sub WorkbookAuto_Open()

NB : option explicit en début de code, c'est pour se forcer à déclarer les variables?

autre question :
Pour la macro AjusterFormatSelection, pourquoi faut-il passer par Intesect ?
En affectant cette macro à un bouton, j'obtiens le message d'erreur :
"la méthode 'Intersect' de l'objer '_global' a échoué.

**ZebreLoup** · 02/01/2012, 10h39

Tu es sur quelle version d'Excel ?

**darkvadave** · 03/01/2012, 13h58

Bonjour et bonne année;
Je suis sur excel2000.
NB : depuis mon dernier message, j'ai trouvé une solution qui fonctionne as trop mal :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub ColorTout1()
Dim c As Range
Dim a As Integer
Dim b As Integer
Dim VNJ As Integer
'Dim NJm As Integer
'a est le nb de lignes précédent le modèle
a = 5
'b est le N° de colonne du modèle
b = 16
For Each c In Range("G10:G35")
'Cells(c.Row, 2).Offset(-1, 0).Value = NJm
VNJ = Cells(c.Row, 2).Value
If VNJ = 7 Then
ElseIf VNJ = 6 And Cells(c.Row, 2).Offset(-1, 0).Value = 6 Then
ElseIf Cells(c.Row, 2).Offset(-1, 0).Value = VNJ Then
' Cells((Cells(c.Row, 2).Value) * 2 + a, b).Select
       c.Value = Cells(VNJ * 2 + a, b).Value
       c.Interior.ColorIndex = Cells(VNJ * 2 + a, b).Interior.ColorIndex
       c.Font.ColorIndex = Cells(VNJ * 2 + a, b).Font.ColorIndex
       c.Font.FontStyle = Cells(VNJ * 2 + a, b).Font.FontStyle
       c.Font.Name = Cells(VNJ * 2 + a, b).Font.Name
       c.Font.Size = Cells(VNJ * 2 + a, b).Font.Size
       c.Font.Underline = Cells(VNJ * 2 + a, b).Font.Underline
    Else
    '   Cells((Cells(c.Row, 2).Value - 1) * 2 + 1 + a, b).Select
       c.Value = Cells((Cells(c.Row, 2).Value - 1) * 2 + 1 + a, b).Value
       c.Interior.ColorIndex = Cells((VNJ - 1) * 2 + 1 + a, b).Interior.ColorIndex
       c.Font.ColorIndex = Cells((VNJ - 1) * 2 + 1 + a, b).Font.ColorIndex
       c.Font.FontStyle = Cells((VNJ - 1) * 2 + 1 + a, b).Font.FontStyle
       c.Font.Name = Cells((VNJ - 1) * 2 + 1 + a, b).Font.Name
       c.Font.Size = Cells((VNJ - 1) * 2 + 1 + a, b).Font.Size
       c.Font.Underline = Cells((VNJ - 1) * 2 + 1 + a, b).Font.Underline
    End If
       Next c
End Sub

Cette macro ne laisse de coté les cellules correspondant au dimanche et au samedi apm.
NJm est un essai raté pour créer une variable donnant le N° du jour précédent celui testé : je ne me souviens plus du message d'erreur.
J'ai créé une autre macro qui sert à remplir les WE :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub ColorGardesWEMaurice()
Dim c As Range
' s est la cellule patron samedi et d la cellule patron dimanche
'Dim s As Range
'Dim d As Range
Dim VNJ As Integer
Dim VNS As Integer
'Dim NJm As Integer
 
For Each c In Range("G10:G35")
'Cells(c.Row, 2).Offset(-1, 0).Value = NJm
VNJ = Cells(c.Row, 2).Value
VNS = Cells(c.Row, 1).Value
's = Range("J4")
'd = Range("K4")
'encore 3 cas à créer :
'si la case NJ est vide (pas de date) : passer à la case suivante
'si on est un JF : passer à la case suivante
'si on est un jour chômé (pont) : passer à la case suivante
'si on est lundi, mardi, mercredi ou jeudi : passer à la cellule suivante
If VNJ < 5 Then
'si on est vendredi matin : passer à la cellule suivante
ElseIf VNJ = 5 And Cells(c.Row, 2).Offset(1, 0).Value = 5 Then
'si on est vendredi apm et qu'on est un GWE : colorer en GWE
ElseIf VNJ = 5 And Cells(c.Row, 2).Offset(-1, 0).Value = 5 And VNS Mod 3 = 0 Then
    c.Value = Range("G4").Value
    c.Interior.ColorIndex = Range("G4").Interior.ColorIndex
    c.Font.ColorIndex = Range("G4").Font.ColorIndex
    c.Font.FontStyle = Range("G4").Font.FontStyle
    c.Font.Name = Range("G4").Font.Name
    c.Font.Size = Range("G4").Font.Size
    c.Font.Underline = Range("G4").Font.Underline
'si on est samedi matin et qu'on est en GWE (le reste du N¨° sem divisé par 3 est 0, alors on colore en GWE
ElseIf VNJ = 6 And Cells(c.Row, 2).Offset(1, 0).Value = 6 And VNS Mod 3 = 0 Then
    c.Value = Range("G4").Value
    c.Interior.ColorIndex = Range("G4").Interior.ColorIndex
    c.Font.ColorIndex = Range("G4").Font.ColorIndex
    c.Font.FontStyle = Range("G4").Font.FontStyle
    c.Font.Name = Range("G4").Font.Name
    c.Font.Size = Range("G4").Font.Size
    c.Font.Underline = Range("G4").Font.Underline
ElseIf VNJ = 6 And Cells(c.Row, 2).Offset(1, 0).Value = 6 Then
' si on est sam apm et que le reste du N° de sem divisé par 3 est de 1, alors  on colore Samedi
ElseIf VNJ = 6 And Cells(c.Row, 2).Offset(-1, 0).Value = 6 And VNS Mod 3 = 1 Then
    c.Value = Range("J4").Value
    c.Interior.ColorIndex = Range("J4").Interior.ColorIndex
    c.Font.ColorIndex = Range("J4").Font.ColorIndex
    c.Font.FontStyle = Range("J4").Font.FontStyle
    c.Font.Name = Range("J4").Font.Name
    c.Font.Size = Range("J4").Font.Size
    c.Font.Underline = Range("J4").Font.Underline
'si on est dimanche et que le reste du N° de sem divisé par 3 est de 1, on colore en dimanche
ElseIf VNJ = 7 And VNS Mod 3 = 1 Then
    c.Value = Range("K4").Value
    c.Interior.ColorIndex = Range("K4").Interior.ColorIndex
    c.Font.ColorIndex = Range("K4").Font.ColorIndex
    c.Font.FontStyle = Range("K4").Font.FontStyle
    c.Font.Name = Range("K4").Font.Name
    c.Font.Size = Range("K4").Font.Size
    c.Font.Underline = Range("K4").Font.Underline
    End If
Next c
End Sub

Mais en définitive, je pense changer d'idée : créer une matrice patron de 3 semaines (car le rythme des gardes est de 3 semaines) numérotées 1, 2 et 3 que je choisirai grâce à l'opérateur Mod.
S'il y a des améliorations possibles, je suis preneur. En particulier, l'inconvnient est d'être obligé de saisir manuellement la zone à colorier et de créer autant de macros que de personnes (à moins d'en faire une globale qui traite le planning d'un coup).

**ZebreLoup** · 03/01/2012, 14h21

Je n'ai plus tous les détails de ton fichier en tête, mais effectivement, ça parait un peu lourd de faire une macro par personne. Il vaudrait mieux mettre des paramètres dans ta procédure pour l'appeler en fonction de la personne. (Sans doute le Range concerné).

macro vba pour remplir un planning excel [XL-2000]

Macros et VBA Excel

Discussions similaires

Partager

Partager