Aide VBA Programmer des alertes et des blocages de cellules

**Mokia34** · 02/11/2012, 14h14

Bonjour,

je dois remplir une fiche d'absence de 13 employés. Je dois écrire un truc en VBA mais je suis bloquée. Est ce que quelqu'un peut maider svp ??

Jai mis le fichier en pièce jointe pour que vous voyez ce que jai ecrit en VBA.

J'ai plusieurs contraintes imposées :
- Ces 13 employés bossent dans un ou plusieurs blocs --> voir dans la colonne A
- Un employé absent dans un bloc l'est aussi dans tous les blocs auxquels il appartient (par exemple si la Pers 7 est absente du bloc 3 le mardi, elle lest aussi du bloc 4 le même jour).
- Dans les blocs 1, 2 et 3, le maximum d'absence accepté est de 2. Lorsqu'une 3ème personne veut se noter absente, elle recoit un message d'alerte et son absence est effacée.
- Dans le bloc 4, le maximum d'absence est de 6. Lorsqu'une 7ème personne veut se noter absente, elle recoit un message d'alerte et son absence est effacée.

Je suis bloquée à cause de ces relations entre les blocs. Par exemple lorsque dans le bloc 1, la personne 3 est absente et dans le bloc 2 la personne 4 et 5 sont absentes, si la personne 1 veut sajouter absente, elle doit etre bloquée par le minimum de présence atteint dans le bloc 2... etc etc

SVP jai vraiment besoin dun coup de pouce car là je suis vraiment bloquée :s

Merci

**Mokia34** · 04/11/2012, 10h05

voila le dernier fichier que jai réussi a faire
jai mis des OK dans le code pour identifier les cas qui marchent
je n'arrive pas à régler le probleme lorsque les cellules sont liées

**Theze** · 04/11/2012, 12h41

Bonjour,

Je me suis penché sur ton cas et je ne sais pas si ce que je te propose ici va te convenir ?
Tout d'abords, pour que l'orthographe des noms des différentes personnes soit exacte, je te conseille de créer une liste et de l'affecter à des listes de validation dans les cellules en colonne A (Données > Validation > Autoriser > Liste).
Ensuite, ce code est à mettre non pas dans le module du classeur mais dans celui de la feuille et ensuite, tu n'as plus qu'à tester. Tien moi au courant :

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
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
97
98
99
100
101
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim Plage As Range
    Dim Plage_Bloc1 As Range
    Dim Plage_Bloc2 As Range
    Dim Plage_Bloc3 As Range
    Dim Plage_Bloc4 As Range
    Dim Cel_Bloc1 As Range
    Dim Cel_Bloc2 As Range
    Dim Cel_Bloc3 As Range
    Dim Cel_Bloc4 As Range
 
    'seulement sur les colonnes B à F
    If Target.Column = 1 Or Target.Column > 6 Then Exit Sub
 
    With Target
 
        'défini la plage sur laquelle agir
        Set Plage = Union(Range(Cells(8, .Column), Cells(10, .Column)), _
                          Range(Cells(13, .Column), Cells(15, .Column)), _
                          Range(Cells(18, .Column), Cells(20, .Column)), _
                          Range(Cells(23, .Column), Cells(34, .Column)))
 
        'défini les plages de recherche
        Set Plage_Bloc1 = Range(Cells(8, .Column), Cells(10, .Column))
        Set Plage_Bloc2 = Range(Cells(13, .Column), Cells(15, .Column))
        Set Plage_Bloc3 = Range(Cells(18, .Column), Cells(20, .Column))
        Set Plage_Bloc4 = Range(Cells(23, .Column), Cells(34, .Column))
 
        'si dans le bloc 1
        If Not Intersect(Target, Plage) Is Nothing Then
 
            'recherche la personne dans les différents blocs
            'si trouvée, affecte la valeur entrée dans la cellule active (qui peut être elle même)
            Set Cel_Bloc1 = Plage_Bloc1.Offset(0, -.Column + 1).Find(Cells(.Row, 1), , xlValues, xlWhole)
 
            If Not Cel_Bloc1 Is Nothing Then
 
                Application.EnableEvents = False
                Cel_Bloc1.Offset(0, .Column - 1) = .Value
                Application.EnableEvents = True
 
            End If
 
            Set Cel_Bloc2 = Plage_Bloc2.Offset(0, -.Column + 1).Find(Cells(.Row, 1), , xlValues, xlWhole)
 
            If Not Cel_Bloc2 Is Nothing Then
 
                Application.EnableEvents = False
                Cel_Bloc2.Offset(0, .Column - 1) = .Value
                Application.EnableEvents = True
 
            End If
 
            Set Cel_Bloc3 = Plage_Bloc3.Offset(0, -.Column + 1).Find(Cells(.Row, 1), , xlValues, xlWhole)
 
            If Not Cel_Bloc3 Is Nothing Then
 
                Application.EnableEvents = False
                Cel_Bloc3.Offset(0, .Column - 1) = .Value
                Application.EnableEvents = True
 
            End If
 
            Set Cel_Bloc4 = Plage_Bloc4.Offset(0, -.Column + 1).Find(Cells(.Row, 1), , xlValues, xlWhole)
 
            If Not Cel_Bloc4 Is Nothing Then
 
                Application.EnableEvents = False
                Cel_Bloc4.Offset(0, .Column - 1) = .Value
                Application.EnableEvents = True
 
            End If
 
            'si dans un des blocs l'effectif minimal est déjà atteint, affiche le message et supprime
            'l'abscence de la personne
            If Application.WorksheetFunction.CountBlank(Plage_Bloc1) < 1 _
                Or Application.WorksheetFunction.CountBlank(Plage_Bloc2) < 1 _
                Or Application.WorksheetFunction.CountBlank(Plage_Bloc3) < 1 _
                Or Application.WorksheetFunction.CountBlank(Plage_Bloc4) < 6 Then
 
                MsgBox "Permanence minimale atteinte !"
 
                Application.EnableEvents = False 'gèle
 
                On Error Resume Next 'évite l'erreur de la personne abscente d'un des blocs
                Cel_Bloc1.Offset(0, .Column - 1) = ""
                Cel_Bloc2.Offset(0, .Column - 1) = ""
                Cel_Bloc3.Offset(0, .Column - 1) = ""
                Cel_Bloc4.Offset(0, .Column - 1) = ""
 
                Application.EnableEvents = True 'rétabli
 
            End If
 
        End If
 
    End With
 
End Sub

Hervé.

**mercatog** · 04/11/2012, 13h12

Code testé sur ton fichier en nommant respectivement les 4 blocs BLOC1, BLOC2, BLOC3 et BLOC4

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
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c As Range, v As Range
Dim Pers As String
Dim Jr As Integer
Dim N As Byte
 
With Sh
    If Target.Column > 1 And Target.Column < 7 Then
        For Each c In Target
            Jr = c.Column
            Pers = .Cells(c.Row, 1)
            For Each v In .Range("A5:A10,A13,A15,A18:A20,A23:A34")
                If v.Value = Pers Then
                    Application.EnableEvents = False
                    .Cells(v.Row, Jr) = c
                    Application.EnableEvents = True
                End If
                N = Verif(Jr)
                If N > 0 And c <> "" Then
                    c.Value = ""
                    MsgBox "Limite dépassée en Bloc " & N & " pour " & .Cells(5, Jr) & " " & .Cells(6, Jr)
                End If
            Next v
        Next c
    End If
End With
End Sub
 
Private Function Verif(ByVal Col As Integer) As Byte
Dim Nb(1 To 4) As Byte, j As Byte, Mx As Byte
 
Mx = 2
With ActiveSheet
    For j = 1 To 4
        Nb(j) = Application.CountA(Intersect(.Columns(Col), .Range("BLOC" & j)))
        If j = 4 Then Mx = 6
        If Nb(j) > Mx Then
            Verif = j
            Exit For
        End If
    Next j
End With
End Function

**Mokia34** · 04/11/2012, 14h17

@ Theze

Cest exactement ca que je voudrais mais il faudrait que les liens des absences de la personne 1 soient conservés (bloc 1 et 2)

a quoi ca sert la validation des données stp ??

merci pour ton aide

@ mercatog

ya un message derreur quand jecris dans le tableau et je ne vois pas pourquoi
merci pour ton aide !!

**Philippe Tulliez** · 04/11/2012, 16h25

Bonjour,

Envoyé par Mokia34

ya un message derreur quand jecris dans le tableau et je ne vois pas pourquoi

Quel message d'erreur et à quelle ligne ?

**gFZT82** · 04/11/2012, 16h41

Bonjour,

Au vu de ton fichier, tu avais oublié de créer les 4 blocs comme te l'avait prescrit mercatog.

Cordialement.

**Mokia34** · 04/11/2012, 19h40

un grand merci !!
savez vous comment ajouter la copie de labsence de la personne 1 du bloc 1 au 2? ou est ce impossible?
encore merci

**gFZT82** · 04/11/2012, 21h47

Re, Re

Pers1, ce n’est pas pareil que Pers 1 (avec un espace entre Pers et 1).
Je reprends ce que t’a signalé Theze (ça devient une habitude de citer mes camarades de jeu

)

Tout d'abord, pour que l'orthographe des noms des différentes personnes soit exacte, je te conseille de créer une liste et de l'affecter à des listes de validation.

Dans l’exemple joint, chaque nom est issu d’une liste de validation qui fait référence à la liste "Personnel" placée dans la feuille "Base". Cela évite les erreurs d’orthographe.

Cordialement.

**Mokia34** · 05/11/2012, 01h22

merci beaucoup a tous !!
ca fait des jours que je galere sur ce programme
merci encore beaucoup beaucoup beaucoup de m'avoir + qu'aidé

**Mokia34** · 05/11/2012, 23h52

Bonsoir,
votre code est compliqué pour moi... :s
je ne comprends pas quoi changer dans votre code pour prendre en compte plus de colonnes (mettre plusieurs semaines cote a cote).

Code :

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

If Target.Column > 1 And Target.Column < 25 Then

et que représente Mx ??
merci !

**mercatog** · 06/11/2012, 00h31

Mx représente le nombre maximum d'absences tolérées par bloc en une journée. Pour les blocs de 1 à 3, Mx=2 et pour le bloc 4, Mx=6

**Mokia34** · 06/11/2012, 08h46

je sollicite encore une fois votre aide car je n'arrive pas a saisir à coté de quoi je passe pour que ca ne marche pas quand j'augmente le nombre de semaines traitées :s

**mercatog** · 06/11/2012, 11h42

Il faudra aussi adapter la plage de cellules correspondant aux noms attribués (BLOC1,...BLOC4)
Désormais il s'agit pour BLOC1 par exemple de

Code :

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

='Janvier 2013'!$B$8:$K$10

...etc

**Mokia34** · 06/11/2012, 20h57

bonsoir !!

cestsuper ca marche nickel

par contre est ce possible de l'adapter si je mets plusieurs onglets (tous les mois de l'année) dans la meme feuille et que toutes les feuilles sont constituées du même tableau
donc on retrouverait les blocs 1,2,3 et 4 pour chacun des 12 onglets.

**mercatog** · 06/11/2012, 21h44

Oui il suffit de nommer les blocs dans chaque feuille (de portée feuille et non classeur)

Aide VBA Programmer des alertes et des blocages de cellules

Macros et VBA Excel

Discussions similaires

Partager

Partager