macro vba pour remplir un planning excel

Version imprimable

21/12/2011, 23h13
darkvadave

macro vba pour remplir un planning excel

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.
22/12/2011, 07h33
Kaera

Salut darkvadave,

Citation:

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*
22/12/2011, 10h13
ZebreLoup

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 ?
22/12/2011, 14h39
darkvadave

1 pièce(s) jointe(s)

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.

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:

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:

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:

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:

Application.Calculation = xlCalculationManual

Et à la fin :

Code:

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.

27/12/2011, 00h18
darkvadave

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:

Private Sub Workbook_Open()

par

Code:

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é.
02/01/2012, 10h39
ZebreLoup

Tu es sur quelle version d'Excel ?

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:

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:

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).

03/01/2012, 14h21
ZebreLoup

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é).