Discussion :

[fredlapotre]

Bonjour,

Je souhaiterais compléter le code suivant pour ne pas écrire dans certaines cellules sélectionnées. Je suis en train de réaliser un planning d'absence et je ne souhaite pas que dans la ligne de commande du code qui suit l'action ne s'écrive pas. En fait, ma ligne de date est en ligne 11 et quand ma cellule sélectionnée ou mes cellules sélectionnées tombent sur un jour ferié ou un samedi ou un dimanche, je ne veux pas que le code s'écrive.

Je vous mets mon classeur en pièce jointe.

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
Sub pld()
 
'pld
 
With Selection
       .Value = "PLD"
                   With .Interior
                          .Pattern = xlSolid
                          .PatternColorIndex = xlAutomatic
                          .Color = RGB(255, 102, 0) 'orange fonce
                          .TintAndShade = 0
                          .PatternTintAndShade = 0
                  End With
                  With .Font
                         .ColorIndex = 1
                         .Size = 7
                  End With
End With
 
End Sub

Planning 2016 essai.xlsm

Cordialement

[unparia]

Bonour

et je ne souhaite pas que dans la ligne de commande du code qui suit l'action ne s'écrive pas

on s'y perd à divers titres, tant en ce qui concerne la formulation, que le sens de cette double négation.

[RyuAutodidacte]

Bonour (He oui moi aussi j'ai envie de dire le Bonour du lundi matin hein unparia ),

une des directions possible :
Avoir la liste des jours fériés à l'endroit voulu dans une feuille puis faire un code vérifiant si la date la date sélectionné est un jour férié ou
un samedi ou dimanche (des formules excel existant déjà faire de même en macro => à chercher)
exemple en formule pour vérifier le jour : =JOURSEM("19/11/2016";2) renvoyant 6, un samedi et donc 7 sera un dimanche
Donc faire de même en macro vérifier 6 ou 7 en plus des jours fériés

grosso modo ça donnera :
Si jours fériés ou samedi ou dimanche
MsgBox "Mon texte"
sinon
mon code
fin du if
bien sur à formuler en macro

[Invité]

http://www.developpez.net/forums/d16...e/#post8779436

[RyuAutodidacte]

un autre exemple vite fait (Vraiment vite fait)
PS : je n'ai pas pinailler sur la façon dont était gérer PLD donc ça sera à adapter => juste pour le principe
Colonne A liste jour férié, à partir de B1, C1 … etc des jour quelconques, PLD étant mis sur une ligne lambda ne connaissant pas ton fichier

01/11/16	22/11/16	23/11/16	01/11/16	11/11/16	26/11/16	27/11/16	28/11/16
11/11/16
		PLD	PLD		PLD

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
Sub FerieSamDim()
 
Ferie = Application.Transpose(Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)))
SamDim = Array(6, 7)
 
J_Ferie = Application.Match(Cells(1, Selection.Column), Ferie, 0)
J_SamDim = Application.Match(Weekday(Cells(1, Selection.Column), vbMonday), SamDim, 0)
 
    With Selection
        If .Value = "PLD" Then
            If Not IsError(J_Ferie) Or Not IsError(J_SamDim) Then
                MsgBox "Jour non valide, modifié l'entrée"
                .ClearContents
            Else
                .Value = "PLD"
                                   With .Interior
                                          .Pattern = xlSolid
                                          .PatternColorIndex = xlAutomatic
                                          .Color = RGB(255, 102, 0) 'orange fonce
                                          .TintAndShade = 0
                                          .PatternTintAndShade = 0
                                  End With
                                  With .Font
                                         .ColorIndex = 1
                                         .Size = 7
                                  End With
            End If
        End If
    End With
End Sub

On pourrait mettre les Match dans le with selection mais c'est pour que tu es une meilleure vision du principe

[fredlapotre]

bonjour,

Merci RyuAutodidacte, je vais voir ton code.

Voici mon planning tu verras peut etre mieux avec mon classeur.

Ton raisonnement est bon.

Cordialement

[RyuAutodidacte]

re,
désolé mais comme la plupart des "forumeurs" je n'ouvre pas les fichiers avec macro pour question de sécurité.
Quoiqu'il en soit le code est facilement adaptable, après il est vrai que je ne connais pas ton niveau.
sur ce post, j'ai donné une explication
N'hésite pas si tu as des questions supp

Edit : je l'ai ouvert sur Mac moins risqué
Par rapport au lien donné ci-dessus voilà une récap des données Macro en tableau

Valeur	FondCell	CoulFont	SizeFont
PLD	RGB(255, 102, 0)	1	7
DJM	RGB(255, 192, 0)	1	7
DJA	RGB(255, 255, 0)	1	7
OPEX	RGB(0, 32, 96)	2	7
OPINT	RGB(0, 112, 192)	1	7
TERR	RGB(219, 238, 243)	1	7
STA	RGB(146, 208, 80)	1	7
SERV	RGB(112, 48, 160)	2	7
RECON	RGB(151, 72, 7)	2	7
DESER	RGB(0, 0, 0)	2	7
PATC	RGB(255, 0, 0)	2	7

La 4è colonne est une valeur fixe donc elle nous servira pas; la 1è col est du texte tandis que la 2è col et la 3è col sont des Valeurs
Une partie de code fourni ne sert à rien on pourrait l'écrire comme cela - partie non grisée (attention le with sur une ligne déconseillé pour la lisibilité et qd on est pas habitué) :

Code :

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

1
2
3
4
5
6
7
8
9
    'With Selection
            'If Not IsError(J_Ferie) Or Not IsError(J_SamDim) Then
                'MsgBox "Jour non valide, modifié l'entrée"
            Else
                .Value = "PLD"
                .Interior.Color = RGB(255, 102, 0) 'orange fonce
                With .Font: .ColorIndex = 1: .Size = 7: End With
            End If
    End With

regarde ce que l'on pourrait faire via le tableau :

Code :

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

1
2
3
4
5
6
7
8
9
    'With Selection
            'If Not IsError(J_Ferie) Or Not IsError(J_SamDim) Then
                'MsgBox "Jour non valide, modifié l'entrée"
            Else
                .Value = Valeur(x)
                .Interior.Color = FondCell(x) 'orange fonce
                With .Font: .ColorIndex = CoulFont(x): .Size = 7: End With
            End If
    End With

x étant la position correspondant à la position des valeurs : si notre valeur est PLD et est en 1ère position on aura Valeur(0) mais partir d'un Match Valeur(x -1),
x qui sera dans ce cas la le résultat du Match => pour PLD on aura alors Valeur(1 - 1) = Valeur(0) => 1ère position

Comme on le disait plus haut : la 1è col est du texte tandis que la 2è col et la 3è col sont des Valeurs
Copie colle le tableau dans excel et sélectionne les valeurs s'en prendre l'entête en utilisant le code adéquat (je te laisse deviner) :

Code :

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

1
2
3
4
Sub BuildArrayText()
    MonArrayText = """" & Join(Application.Index(Application.Transpose(Selection.Value), 1, 0), """, """) & """"
    Debug.Print Selection.Offset(-1).Resize(1) & " = Array(" & MonArrayText & ")"
End Sub

Code :

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

1
2
3
4
Sub BuildArrayValue()
    MonArrayValue = Join(Application.Index(Application.Transpose(Selection.Value), 1, 0), ", ")
    Debug.Print Selection.Offset(-1).Resize(1) & " = Array(" & MonArrayValue & ")"
End Sub

tu vas pourvoir récupérer les arrays tout fait
suis le lien ci-dessus quitte à relire tout le post, inspires en toi.
Je te laisse réfléchir à la manière de récupérer la valeur voulu (ex : PDL ou autre) afin de récupérer l'ensemble des valeurs avec just la partie de code montré ci-dessus (où il y le code en partie grisé)

en attendant le code vite fait de la demande initial :

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
Sub FerieSamDim()
 Dim Ferie As Variant
Ferie = Application.Transpose(Sheets("Jours feriés").Range(Sheets("Jours feriés").Cells(7, 4), Sheets("Jours feriés").Cells(Rows.Count, 4).End(xlUp)))
SamDim = Array(6, 7)
 
J_Ferie = Application.Match(Cells(10, Selection.Column), Ferie, 0)
J_SamDim = Application.Match(Weekday(Cells(10, Selection.Column), vbMonday), SamDim, 0)
 
    With Selection
            If Not IsError(J_Ferie) Or Not IsError(J_SamDim) Then
                MsgBox "Jour non valide, modifié l'entrée"
            Else
                .Value = "PLD"
                .Interior.Color = RGB(255, 102, 0) 'orange fonce
                With .Font: .ColorIndex = 1: .Size = 7: End With
            End If
    End With
End Sub

[Invité]

Bonjour,

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
Sub pld()With Selection
If Ferier(.Parent.Cells(10, .Column)) = True Then Exit Sub
    .Value = "PLD"
    With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = RGB(255, 102, 0) 'orange fonce
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With .Font
        .ColorIndex = 1
        .Size = 7
    End With
End With
End Sub

[fredlapotre]

Bonsoir,

merci pour tout à vous tous.

Maintenant, je vais me mettre au travail.

Cordialement

[RyuAutodidacte]

hi,
Alors on en est où de ce travail

Ne regarder qu'après le travail rendu : pas de triche
Voilà le code finalisé, attention ne regarde qu'une fois ton travail accompli

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
Sub ClicBoutons() ' Affecter cette macro à tous les boutons
Dim BtnCapt As String, Position As Byte
        BtnCapt = Replace(ActiveSheet.Buttons(Application.Caller).Caption, vbLf, "") 'Récup du titre du bouton cliqué
        Btn_Caption = Array("PLD", "DJM", "DJA", "OPEX", "OPINT", "TERR", "STAGE", "SERV", "RECON", "DESER", "PATC") 'Array des titres des boutons
        Position = Application.Match(BtnCapt, Btn_Caption, 0) 'on cherche la position
        'MsgBox Position & " - " & Btn_Caption(Position - 1)
        FerieSamDim Position 'on envoie le résultat dans les Sub FerieSamDim dont on active le process
End Sub
 
 
Sub FerieSamDim(Position As Byte)
Dim Ferie As Variant
 
'Ici les paramètres 3 Arrays permettant de mettre la Valeur du texte, la couleur de fond et la couleur du texte
Valeur = Array("PLD", "DJM", "DJA", "OPEX", "OPINT", "TERR", "STA", "SERV", "RECON", "DESER", "PATC")
FondCell = Array(RGB(255, 102, 0), RGB(255, 192, 0), RGB(255, 255, 0), RGB(0, 32, 96), RGB(0, 112, 192), RGB(219, 238, 243), RGB(146, 208, 80), RGB(112, 48, 160), RGB(151, 72, 7), RGB(0, 0, 0), RGB(255, 0, 0))
CoulFont = Array(1, 1, 1, 2, 1, 1, 1, 2, 2, 2, 2)
 
'Création d'un Array récupérant les jours feriés (Bien les formules mettant le jours feriés automatiquement qq soit l'année, j'ai déjà fait cela)
Ferie = Application.Transpose(Sheets("Jours feriés").Range(Sheets("Jours feriés").Cells(7, 4), Sheets("Jours feriés").Cells(Rows.Count, 4).End(xlUp)))
SamDim = Array(6, 7) 'Array : valeur du samedi et dimanche
 
J_Ferie = Application.Match(Cells(10, Selection.Column), Ferie, 0) 'Pour vérification des jours feriés
J_SamDim = Application.Match(Weekday(Cells(10, Selection.Column), vbMonday), SamDim, 0) 'Pour vérification des Samedi Dimanche
 
    With Selection
            If Not IsError(J_Ferie) Or Not IsError(J_SamDim) Then 'On teste les jours
                MsgBox "Jour non valide, modifié l'entrée"
            Else 'Si OK on récupère les valeurs dans les 3 Arrays
                .Value = Valeur(Position - 1)
                .Interior.Color = FondCell(Position - 1)
                With .Font: .ColorIndex = CoulFont(Position - 1): .Size = 7: End With
            End If
    End With
End Sub

He oui je l'ai masqué intentionnellement, gare à la tentation

on pourrait y rajouter un Intersect … … à toi de regarder

Mis à part Effacement des données tout tes boutons son gérés

Voilà

Edit : le tableau des valeurs (on aurait pu éviter STA et STAGE car tous les autres noms sont identiques du coup on pourrait supprimer un Array)

Btn_Caption	Valeur	FondCell	CoulFont
PLD	PLD	RGB(255, 102, 0)	1
DJM	DJM	RGB(255, 192, 0)	1
DJA	DJA	RGB(255, 255, 0)	1
OPEX	OPEX	RGB(0, 32, 96)	2
OPINT	OPINT	RGB(0, 112, 192)	1
TERR	TERR	RGB(219, 238, 243)	1
STAGE	STA	RGB(146, 208, 80)	1
SERV	SERV	RGB(112, 48, 160)	2
RECON	RECON	RGB(151, 72, 7)	2
DESER	DESER	RGB(0, 0, 0)	2
PATC	PATC	RGB(255, 0, 0)	2

[RyuAutodidacte]

hi dysorthographie ,

j'étais en train de faire une modification de mon code car je n'avais pas pris en compte la sélection de plusieurs jours
car dans ce cas là on pourrait tomber sur le week end ou un jour férié
Mon code test avant insertion sur le code final :

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
Sub test()
Dim JoursSelect As Range
 
    Ferie = Application.Transpose(Sheets("Jours feriés").Range(Sheets("Jours feriés").Cells(7, 4), Sheets("Jours feriés").Cells(Rows.Count, 4).End(xlUp)))
    SamDim = Array(6, 7)
 
    If Selection.Columns.Count >= 1 Then
        Set JoursSelect = Range(Cells(10, Selection.Column), Cells(10, Selection.Column + Selection.Columns.Count - 1))
 
        For Each Jour In JoursSelect
 
            J_Ferie = Application.Match(Jour, Ferie, 0)
            J_SamDim = Application.Match(Weekday(Jour, vbMonday), SamDim, 0)
 
                    If Not IsError(J_Ferie) Or Not IsError(J_SamDim) Then
                        MsgBox "Jour non valide sélectionné, " & vbCrLf & _
                                        "modifier la sélection", vbExclamation
                        Set JoursSelect = Nothing: Exit Sub
                    End If
        Next
    End If
End Sub

Je me suis posé la question si ton code faisait la même chose (je ne doute pas que tu es pris en considérations l'ensemble des paramètres,
vu ton excellent niveau par rapport mien toujours en apprentissage) mais comme je suis curieux, je l'ai testé (PS sympa la fonction des jours feriés )

Je suis quand même tombé sur quelque chose (après c'est peut être pas important, mais ce n'est pas à moi d'en juger) :
lorsque l'on sélectionne plusieurs jours à cheval sur le week-end (Mer jeu ven sam dim lun mar par exemple), ton code s'applique et modifie le samedi et dimanche selon le bouton cliqué
Pas dans le contexte lors de la création du code? … ? qu'en est il ?

[RyuAutodidacte]

Bonjour,
Modification du code suite à mon post ci-dessus (je remet l'ensemble):

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
Sub ClicBoutons() ' Affecter cette macro à tous les boutons
Dim BtnCapt As String, Position As Byte
        BtnCapt = Replace(ActiveSheet.Buttons(Application.Caller).Caption, vbLf, "") 'Récup du titre du bouton cliqué
        Btn_Caption = Array("PLD", "DJM", "DJA", "OPEX", "OPINT", "TERR", "STAGE", "SERV", "RECON", "DESER", "PATC") 'Array des titres des boutons
        Position = Application.Match(BtnCapt, Btn_Caption, 0) 'on cherche la position
        'MsgBox Parametres & " - " & Btn_Caption(Parametres - 1)
        FerieSamDim Position 'on envoie le résultat dans les Sub FerieSamDim dont on active le process
End Sub
 
 
Sub FerieSamDim(Position As Byte)
Dim Ferie As Variant
 
'Ici les paramètres 3 Arrays permettant de mettre la Valeur du texte, la couleur de fond et la couleur du texte
Valeur = Array("PLD", "DJM", "DJA", "OPEX", "OPINT", "TERR", "STA", "SERV", "RECON", "DESER", "PATC")
FondCell = Array(RGB(255, 102, 0), RGB(255, 192, 0), RGB(255, 255, 0), RGB(0, 32, 96), RGB(0, 112, 192), RGB(219, 238, 243), RGB(146, 208, 80), RGB(112, 48, 160), RGB(151, 72, 7), RGB(0, 0, 0), RGB(255, 0, 0))
CoulFont = Array(1, 1, 1, 2, 1, 1, 1, 2, 2, 2, 2)
 
'Création d'un Array récupérant les jours feriés (Bien les formules mettant le jours feriés automatiquement qq soit l'année, j'ai déjà fait cela)
Ferie = Application.Transpose(Sheets("Jours feriés").Range(Sheets("Jours feriés").Cells(7, 4), Sheets("Jours feriés").Cells(Rows.Count, 4).End(xlUp)))
SamDim = Array(6, 7) 'Array : valeur du samedi et dimanche
 
    With Selection
        Set JoursSelect = Range(Cells(10, .Column), Cells(10, .Column + .Columns.Count - 1))
 
        For Each Jour In JoursSelect
            J_Ferie = Application.Match(Jour, Ferie, 0) 'Pour vérification des jours feriés
            J_SamDim = Application.Match(Weekday(Jour, vbMonday), SamDim, 0) 'Pour vérification des Samedi Dimanche
 
            If Not IsError(J_Ferie) Or Not IsError(J_SamDim) Then 'On teste les jours
                MsgBox "Jour non valide sélectionné, " & vbCrLf & _
                                "modifier la sélection", vbExclamation
                Set JoursSelect = Nothing: Exit Sub
            End If
        Next
            'Si pas de message, on récupère les valeurs dans les 3 Arrays
            .Value = Valeur(Position - 1)
            .Interior.Color = FondCell(Position - 1)
            With .Font: .ColorIndex = CoulFont(Position - 1): .Size = 7: End With
 
    End With
End Sub