Automatisation d'une feuille de garde

[salsitawapa]

Bonjour à tous, me re-voici. Je cherche depuis une semaine à trouver une formule pour une feuille de garde mais le problème est que je ne trouve pas. Voila j'essaie de rajeunir un peu la feuille de garde de mon boulot (pompier). Par soucis de confidentialité, j'ai remplacé les noms par des numéros.
Le fichier excel se compose de 4 feuilles (Jour, nuit, Garde et macro1).
En fait j'ai créé la feuille garde qui par la suite ira chercher dans le tableau des gardes qui travail et quand.
Dans la feuille garde, on peut voir qu'il y a 3 équipe (qui travail 24 h par garde) avec un "g" une case sur 3, et il y a 5 équipe (qui travail 12 h par garde) notée "j" pour le travail de jour suivis de "n" pour le travail de nuit suivi de 3 cases vide.
J'aimerais que l'orsque l'on met la date sur la feuille de jour, les noms des personnes en "g" et en "j" se mettent automatiquement dans les cases colorée (idem pour la nuit avec "g" et "n").
Ces cases colorés sont en 2 colonnes (les mêmes que sur leurs droites ou l'on voit les n° de chambre et le nom). La colonne de gauche et pour les non conducteurs poids lourds et celle de droite pour les conducteurs poids lourds. J'aimerais que lorsque les noms et les n° de chambre se mettent, les colonnes soit respecté (ainsi que pour les sous officier caporaux...).
Je ne sais pas si les explications sont bonnes, mais j'ai joint le fichier cela sera peut être plus clair. Merci de votre aide !

Fichier excel

 

[Gorfael]

Re : Automatisation d'une feuille de garde

Salut
Question feuilles Jour/nuit
SO 12h
de AC59 à AC73 et colonne de Droite ? de AF59 à AF73 ?

 

[salsitawapa]

Re : Automatisation d'une feuille de garde

Salut Gorfael, désolé j'ai oublié de les remettre ces sous officiers. Ils ne prennent qu'une garde par moi en journée. Je crois qu'ils ne sont pas conducteurs (tout de façon, ils ne vont pas conduire la seule garde qu'ils prennent). Si je me trompe, je corrigerai cela. C'est vrai j'ai oublié de les mettre en couleur...
Merci !

Fichier excel

 

[salsitawapa]

Re : Automatisation d'une feuille de garde

Bonsoir tous le monde, quelqu'un a pu trouver une idée ? car j'ai essayé de changer la macro, d'en faire une par type (sous officier, caporaux...) mais rien a faire, je n'ai pas trouvé. Merci de vos réponse

 

[Gorfael]

Re : Automatisation d'une feuille de garde

Bonsoir tous le monde, quelqu'un a pu trouver une idée ? car j'ai essayé de changer la macro, d'en faire une par type (sous officier, caporaux...) mais rien a faire, je n'ai pas trouvé. Merci de vos réponse

Salut
J'ai une flemme..... donc, au lieu de réflèchir au code, j'ai fait du copier/coller
et du remplacement, ce qui fait que mon fichier est trop lourd :
Tu le décompresses
tu te retrouves avec un fichier Mod_test.bas
tu ouvres ton fichier de test de feuille de garde
Alt+F11 => tu passes sous VBE

fenêtre Pojet - VBAProject>>clic droit>>Importer un fichier
parcourir, etc.. et tu valides

et tu essaies (attention, ta 3me feuille doit être nommée "garde"
si ça te va, on pourra améliorer le code, mais comme ça, il est plus lisible, sinon il faut que je crées des variables supplémentaires avec un select case, mais c'est pour plus tard
A+

 

[salsitawapa]

Re : Automatisation d'une feuille de garde

Re bonsoir, merci sa a l'air de fonctionner très bien. Demain je serai au boulot et je le testerai avec la vrai feuille de garde. Je te remercie bcp et te tiens informé.
Pour le code, je pense que l'on peut le laisser comme ça ! Je l'étudierai en détail pour voir comment tu as fait.
Merci !!!

 

[Gorfael]

Re : Automatisation d'une feuille de garde

Salut à tous
comme tu as fait une liaison date entre la page de garde et la page jour, il faudrait faire de même avec "nuit"
tu peux déclencher la macro de manière automatique en collant cette macro sur le module "jour"

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Err_Worksheet_Change
    'si on change la date
    If Target.Address <> "$E$5" Then GoTo Sort_Worksheet_Change
    'on bloque le rafraîchissement écran
    Application.ScreenUpdating = False
    'on bloque les événements
    Application.EnableEvents = False
    'on lance la macro
    Call Macro_Test
    
Sort_Worksheet_Change:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
Err_Worksheet_Change:
    MsgBox (Err.Number & " - " & Err.Description)
    Resume Sort_Worksheet_Change
End Sub

Feuielles "jour" en K1, ce serait mieux d'avoir :
=ANNEE(E5)
et =Jour!K1 en K1 de "nuit

Pour le reste, change de date en A1 du fichier joint et regarde si ça t'interesse
A+

 

[Bebere]

Re : Automatisation d'une feuille de garde

bonjour Salsitawapa
code équipe1 g 24h et équipe2 j 12h

Private Sub FeuilJourEq124()
Dim Plg As Variant, EqG As Variant, EqD As Variant, LetC As String
Dim L As Byte, L1 As Byte, L2 As Byte, I As Byte, I1 As Byte, E As Byte

application.screenupdating=false

Plg = Range("P11:T38")

For L = 1 To UBound(Plg, 1)
If Plg(L, 1) <> "" Then I = I + 1 'compte
If Plg(L, 4) <> "" Then I1 = I1 + 1
Next L

ReDim EqG(1 To I, 1 To 4)
ReDim EqD(1 To I1, 1 To 4)
I = 0: I1 = 0
For L = 1 To UBound(Plg, 1)
If L = 1 Then Plg(L, 3) = 20 'sofae
If L = 11 Then Plg(L, 3) = 30 'sonfae
If L = 17 Then Plg(L, 3) = 36 'iiavsab
If L = 24 Then Plg(L, 3) = 43 'i
Next L


For L = 1 To UBound(Plg, 1)
If Plg(L, 1) <> "" Then
I = I + 1
EqG(I, 1) = Plg(L, 1)
EqG(I, 2) = Plg(L, 2)
If Plg(L, 3) > 0 Then EqG(I, 3) = Plg(L, 3)
End If

If Plg(L, 4) <> "" Then
I1 = I1 + 1
EqD(I1, 1) = Plg(L, 4)
EqD(I1, 2) = Plg(L, 5)
If Plg(L, 3) > 0 Then EqD(I1, 3) = Plg(L, 3)
End If

Next L

With Sheets("Garde")
Plg = .Range("N4:AS22")
'If E = 1 Then Plg = .Range("N4:AS22")
'If E = 2 Then Plg = .Range("N31:AS48")
'If E = 3 Then Plg = .Range("N41:AS74")
monjour = .Range("A1").Value
End With

For L = 1 To UBound(EqG, 1)
For L1 = 2 To UBound(Plg, 1)
If Plg(L1, UBound(Plg, 2)) = EqG(L, 2) Then 'compare noms
For I = 1 To UBound(Plg, 2)
If Plg(1, I) = monjour Then
EqG(L, 4) = Plg(L1, I) 'la garde
Exit For
End If
Next I
Exit For
End If
Next L1
Next L
'écrit dans jour cellules j,k
L1 = 0
For L = 1 To UBound(EqG, 1)
If EqG(L, 3) > 0 Then
I = EqG(L, 3)
LetC = "L"
Else: LetC = "J"
End If
If I = 20 Then L1 = Range(LetC & "28").End(xlUp).Row + 1
If I = 30 Then L1 = Range(LetC & "34").End(xlUp).Row + 1
If I = 36 Then L1 = Range(LetC & "41").End(xlUp).Row + 1
If I = 43 Then L1 = Range(LetC & "50").End(xlUp).Row + 1

Range("J" & L1) = EqG(L, 1)
Range("K" & L1) = EqG(L, 2)
Next L

For L = 1 To UBound(EqG, 1)
For L1 = 2 To UBound(Plg, 1)
If Plg(L1, UBound(Plg, 2)) = EqG(L, 2) Then 'compare noms
For I = 1 To UBound(Plg, 2)
If Plg(1, I) = monjour Then
EqG(L, 4) = Plg(L1, I) 'la garde
Exit For
End If
Next I
Exit For
End If
Next L1
Next L
'écrit dans jour cellules m,n
I = 0: I1 = 0
For L = 1 To UBound(EqD, 1)
If EqD(L, 3) > 0 Then
I = EqD(L, 3)
LetC = "L"
Else: LetC = "M"
End If
If I = 20 Then I1 = Range(LetC & "28").End(xlUp).Row + 1
If I = 30 Then I1 = Range(LetC & "34").End(xlUp).Row + 1
If I = 36 Then I1 = Range(LetC & "41").End(xlUp).Row + 1
If I = 43 Then I1 = Range(LetC & "50").End(xlUp).Row + 1

Range("M" & I1) = EqD(L, 1)
Range("N" & I1) = EqD(L, 2)
Next L


FeuilJourEq212
End Sub

Private Sub FeuilJourEq212()
Dim Plg As Variant, EqG As Variant, EqD As Variant, LetC As String
Dim L As Byte, L1 As Byte, L2 As Byte, I As Byte, I1 As Byte, E As Byte

Plg = Range("V40:Z57")

For L = 1 To UBound(Plg, 1)
If IsNumeric(Plg(L, 1)) And Plg(L, 1) <> "" Then I = I + 1 'compte
If Plg(L, 4) > 0 Then I1 = I1 + 1
Next L

ReDim EqG(1 To I, 1 To 4)
ReDim EqD(1 To I1, 1 To 4)
I = 0: I1 = 0
For L = 1 To UBound(Plg, 1)
If L = 1 Then Plg(L, 3) = 20 'sofae
If L = 6 Then Plg(L, 3) = 36 'sonfae
If L = 9 Then Plg(L, 3) = 43 'ccavsab
If L = 14 Then Plg(L, 3) = 52 'c
Next L


For L = 1 To UBound(Plg, 1)
If IsNumeric(Plg(L, 1)) And Plg(L, 1) <> "" Then
I = I + 1
EqG(I, 1) = Plg(L, 1)
EqG(I, 2) = Plg(L, 2)
If Plg(L, 3) > 0 Then EqG(I, 3) = Plg(L, 3)
End If

If IsNumeric(Plg(L, 4)) And Plg(L, 4) <> "" Then
I1 = I1 + 1
EqD(I1, 1) = Plg(L, 4)
EqD(I1, 2) = Plg(L, 5)
If Plg(L, 3) > 0 Then EqD(I1, 3) = Plg(L, 3)
End If

Next L

With Sheets("Garde")
Plg = .Range("N86:AS130")
monjour = .Range("A1").Value
End With

For L = 1 To UBound(EqG, 1)
For L1 = 16 To UBound(Plg, 1)
If Plg(L1, UBound(Plg, 2)) = EqG(L, 2) Then 'compare noms
For I = 1 To UBound(Plg, 2)
If Plg(1, I) = monjour Then
EqG(L, 4) = Plg(L1, I) 'la garde
Exit For
End If
Next I
Exit For
End If
Next L1
Next L
'écrit dans jour colonnes j,k
I = 0: I1 = 0
For L = 1 To UBound(EqG, 1)
If EqG(L, 3) > 0 Then I = EqG(L, 3)
If Range("J" & I) = "" Then
LetC = "L"
Else: LetC = "J"
End If

If I = 20 Then L1 = Range("J" & "28").End(xlUp).Row + 1
'If I = 30 Then L1 = Range("J" & "34").End(xlUp).Row + 1
If I = 36 Then L1 = Range(LetC & "41").End(xlUp).Row + 1
If I = 43 Then L1 = Range(LetC & "50").End(xlUp).Row + 1
If I = 52 Then L1 = Range(LetC & "57").End(xlUp).Row + 1

Range("J" & L1) = EqG(L, 1)
Range("K" & L1) = EqG(L, 2)
Next L

For L = 1 To UBound(EqD, 1)
For L1 = 16 To UBound(Plg, 1)
If Plg(L1, UBound(Plg, 2)) = EqD(L, 2) Then 'compare noms
For I = 1 To UBound(Plg, 2)
If Plg(1, I) = monjour Then
EqD(L, 4) = Plg(L1, I) 'la garde
Exit For
End If
Next I
Exit For
End If
Next L1
Next L
'écrit dans jour colonnes m,n
I = 0: I1 = 0
For L = 1 To UBound(EqD, 1)
If EqD(L, 3) > 0 Then I = EqD(L, 3)
If Range("M" & I) = "" Then
LetC = "L"
Else: LetC = "M"
End If
If I = 20 Then I1 = Range(LetC & "28").End(xlUp).Row + 1
If I = 36 Then I1 = Range(LetC & "34").End(xlUp).Row + 1
If I = 43 Then I1 = Range(LetC & "51").End(xlUp).Row + 1
If I = 52 Then I1 = Range(LetC & "57").End(xlUp).Row + 1

Range("M" & I1) = EqD(L, 1)
Range("N" & I1) = EqD(L, 2)
Next L
application.screenupdating=true

End Sub

à bientôt

 

[Gorfael]

Re : Automatisation d'une feuille de garde

Salut à tous
merci Bebere de me rappeler que les Bound(tab) existe. J'y mense jamais, mais ça permet de faire une infinité de tableau avec seulement une ou deux variables
A+

 

[salsitawapa]

Re : Automatisation d'une feuille de garde

Bonjour a tous, j'ai testé le 1er code au boulot, il ne fonctionnait plus dès que je mettais les vrais noms. Je me suis envoyé le fichier (car je ne l'avais plus avec les vrais noms). Je viens de faire le 1er code reçu, il marche sur mon excel (j'espère qu'avec la version du boulot il fonctionnera excel 2000 V9.0.3821 SR-1). J'ai également testé le 2ième code (celui de beber), et d'après le résultat, il n'est pas complet ? Il ne fait que l'équipe 1 en 24h et l'équipe 2 en 12h ?
Sinon comment je peux enregistrer pour être sûr qu'il fonctionne au boulot ? Si vous voulez l'exemple avec les vrais noms, demandez moi et je le mettrai.
Petite autre question. Comment faire avec le code de gorfael pour que dès que l'on active la macro, les cellules J20:K57 et M20:N57 ne se mettent plus en jaune ? Puique j'avais mis la couleur pour l'exemple.
Désolé de n'avoir pas répondu avant mais avec les horraires du boulot c'est difficile.
En tout cas, merci à tous

 

[Bebere]

Re : Automatisation d'une feuille de garde

bonsoir Salsitawapa,Gorfael
oui je n'ai géré que eq1g24h et eq2j12h(pourquoi pas eq1,eq2,eq3 sur même colonne,dans feuille jour),
pour feuille garde je te propose de faire un userform et de mettre les données de feuille garde en base de données,à toi de voir
à bientôt

 

[salsitawapa]

Re : Automatisation d'une feuille de garde

Salut à tous, je pense que comme sa c'est très bien. Si cela ne marche pas, j'essayerai de faire comme tu m'as dit.
C'est très bien pour la macro qui s'exécute toute seule. Moi j'avais mis un bouton ! je n'ai pas un très bon niveau mais au moins j'apprends !!!
Pour la couleur qui se met toute seule (avec la macro de Gorfael), a quel endroit est-ce que je dois l'enlever ?
Merci bcp et bonne nuit, je vais me reposer je me suis blessé aujourd'hui.
Ciao

 

[Gorfael]

Re : Automatisation d'une feuille de garde

Salut à tous, je pense que comme sa c'est très bien. Si cela ne marche pas, j'essayerai de faire comme tu m'as dit.
C'est très bien pour la macro qui s'exécute toute seule. Moi j'avais mis un bouton ! je n'ai pas un très bon niveau mais au moins j'apprends !!!
Pour la couleur qui se met toute seule (avec la macro de Gorfael), a quel endroit est-ce que je dois l'enlever ?
Merci bcp et bonne nuit, je vais me reposer je me suis blessé aujourd'hui.
Ciao

Salut
Dire que je me suis fait chi.. pour trouver la bonne couleur que j'effaçais avec la copie des nom

dans la macro, recherche (Menu édition>>rechercher) : ColorIndex
il existe à 2 endroits
Puis tu effaces tout ça :
Range( _
"J20:K28,J30:K33,J34:K34,J36:K41,J43:K49,J50:K50,J52:K56,J57:K57,M20:N27,M28:N28,M30:N34,M36:N41,M43:N50,M52:N57" _
).Select
Selection.Interior.ColorIndex = 36
Comme le code à l'air de convenir, je vais le condenser (et non pas : con-danser), en utilisant mon de variables
A+

 

[salsitawapa]

Re : Automatisation d'une feuille de garde

Bonjour et merci. Je suis vraiment désolé pour la couleur, je ne savais pas que tu avais cherché pour la mettre. Je mettais pas attardé dessus et c'est de ma faute puisque je n'avais pas dit que j'avais mis les couleurs pour l'exemple. Désolé et encore merci.
En se qui concerne le fait que au boulot dès que l'on change les noms, la macro ne fonctionne plus, est-ce que sa peut venir de la version ? et si oui comment faire ? Sa me marquait erreur d'exécution 9 comme erreur.
Petite question histoire de ne pas faire de bétises. Si un jour je veux mettre plus de caporaux en équipes 12h, il suffit de changer la ligne de fin des caporaux voulu ? de cet macro ci :

'Caporaux -------------------------------------------------------------------------------
Range("Q48:Q51,W48:W51,AC48:AC51,Q66:Q69,W67:W69").Select
For X = 1 To N
For Each Cel In Selection
If Tab_Jour(3, X) = Cel Then
Tab_Jour(2, X) = Cel.Offset(0, -1).Address & ":" & Cel.Address
Tab_Jour(1, X) = "G_C"
Exit For
End If
Next Cel
Next X
Range("T48:T51,Z48:Z51,AF48:AF51,T66:T69,Z67:Z69").Select
For X = 1 To N
For Each Cel In Selection
If Tab_Jour(3, X) = Cel Then
Tab_Jour(2, X) = Cel.Offset(0, -1).Address & ":" & Cel.Address
Tab_Jour(1, X) = "D_C"
Exit For
End If
Next Cel
Next X


En tout cas merci bcp !!!

 

[salsitawapa]

Re : Automatisation d'une feuille de garde

En plus de ma question ci-dessus, comment mettre au total 12 conditions si ? puisque en fait en B1 (a coté du jour) j'ai mis la formule =mois(Jour!E5). Se qui me donne le mois en cours, et par rapport a ce mois, j'aimerais que dans mon tableau Garde, entre le 1er et le 31 de chaque mois cela me mette le mois en cours également. J'ai essayé avec 12 si mais comme on ne peut pas en mettre plus de 8, je ne sais pas comment faire.
Merci de vos réponses

 

[Bebere]

Re : Automatisation d'une feuille de garde

bonjour à tous
une proposition
en n4 tu colles ce qui est entre parenthèses"=1&"/"&MOIS(Jour!$E$5)"
en o4 tu colles ce qui est entre parenthèses"=GAUCHE(N4;CHERCHE("/";N4;1)-1)+1&"/"&MOIS(Jour!$E$5)"
et tu recopies vers la droite
le résultat donne 1/7,2/7,etc
à bientôt