Empêcher la modification d'une cellule

Version imprimable

Bonjour,

Pour situer, je suis en plein dans une boucle ... j'écris dans ma cellule N35 (selon la boucle ça peut être O35, P35, Q35, R35) la date système et j'aimerais arriver à bloquer la sélection dans la cellule N39 (selon la boucle ça peut être respectivement O39, P39, Q39, R39). Mais je ne vois pas comment faire... j'ai essayé plusieurs propositions dans les fils de discussion des forums que j'ai pu trouver mais je n'arrive pas à aboutir un code...

Voici ma boucle :
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 If Range("N36").Value = True Then nomCel = "N" Call RecuperationComplete(typeA, nomCel, formA) chbValiderN36.Value = False Range("N35").Value = Date ****************************** ElseIf Range("O36").Value = True Then nomCel = "O" Call RecuperationComplete(typeA, nomCel, formA) chbValiderO36.Value = False Range("O35").Value = Date ****************************** ElseIf Range("P36").Value = True Then nomCel = "P" Call RecuperationComplete(typeA, nomCel, formA) chbValiderP36.Value = False Range("P35").Value = Date ****************************** ElseIf Range("Q36").Value = True Then nomCel = "Q" Call RecuperationComplete(typeA, nomCel, formA) chbValiderQ36.Value = False Range("Q35").Value = Date ****************************** ElseIf Range("R36").Value = True Then nomCel = "R" Call RecuperationComplete(typeA, nomCel, formA) chbValiderR36.Value = False Range("R35").Value = Date ****************************** End If
J'aimerai faire mon bloquage de cellule là où j'ai mis les ******************************

J'espère que j'ai été assez claire...

Merci d'avance

Salut juju1988 et le forum
Un extrait de code ne nous aide pas. Le code entier, oui.
Pour ce que j'en comprends, tu peux essayer avec SelectionChange :

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Sel_Erreur
Dim Plage As Range, Cel As Range
Application.EnableEvents = False
If Not (Intersect(Target, Range("N39:R39")) Is Nothing) Then
    For Each Cel In Target
        If Intersect(Cel, Range("N39:R39")) Is Nothing Then
            If Plage Is Nothing Then
                Set Plage = Cel
            Else
                Set Plage = Union(Plage, Cel)
            End If
        Else
            If Plage Is Nothing Then
                Set Plage = Cel.Offset(1, 0)
            Else
                Set Plage = Union(Plage, Cel.Offset(1, 0))
            End If
        End If
    Next Cel
    Plage.Select
End If
Sel_Sortie:
    Application.EnableEvents = True
    Exit Sub
Sel_Erreur:
    MsgBox Err.Description, vbOKOnly, "erreur n°" & Err.Number
    Resume Sel_Sortie
End Sub

Ouais, je sais, c'est complexe, mais faut bien que je m'amause :D

Gestion des erreurs : rendue obligatoire (à mon sens), puisqu'on utilise une instruction de portée application : faut remettre la gestion des évènements, mais si excel détecte une erreur.

Si on sélectionne une cellule de O39 à R39, la sélection saute en O40 à R40. Même si c'est une sélection multiple.
A+

09/09/2010, 18h21
Pierre Fauconnier

Bonjour.

Qu'entends-tu par "empêcher la modification d'une cellule"? La verrouiller, empêcher la sélection? Permettre la sélection mais pas la modification à la main?

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
64
65
66
'Procédure qui valide les colonnes ajoutées par le labo
'On valide les colonnes qui ont une checkbox cochée
 
Private Sub Valider_Final_Autre_Click()
 
Dim typeA As String
Dim nomCel As String
Dim formA As Integer
 
Application.ScreenUpdating = False
 
Call Ouvre
 
'Attribution type analyse en fonction de la sélection du traitement
If Range("E4") = "Régénération" Then
    typeA = "Régé"
ElseIf Range("E4") = "React" Then
    typeA = "React"
ElseIf Range("E4") = "Valorisation" Then
    typeA = "Valorisation"
ElseIf Range("E4") = "Recyclage" Then
    typeA = "Recyclage"
ElseIf Range("E4") = "Présulfuration" Then
    typeA = "Presulf"
ElseIf Range("E4") = "Régé + React" Then
    typeA = "Régé + React"
Else
    typeA = "Régé + Présulf"
End If
 
formA = 4
 
If Range("N36").Value = True Then
    nomCel = "N"
    Call RecuperationComplete(typeA, nomCel, formA)
    chbValiderN36.Value = False
    Range("N35").Value = Date
ElseIf Range("O36").Value = True Then
    nomCel = "O"
    Call RecuperationComplete(typeA, nomCel, formA)
    chbValiderO36.Value = False
    Range("O35").Value = Date
ElseIf Range("P36").Value = True Then
    nomCel = "P"
    Call RecuperationComplete(typeA, nomCel, formA)
    chbValiderP36.Value = False
    Range("P35").Value = Date
ElseIf Range("Q36").Value = True Then
    nomCel = "Q"
    Call RecuperationComplete(typeA, nomCel, formA)
    chbValiderQ36.Value = False
    Range("Q35").Value = Date
ElseIf Range("R36").Value = True Then
    nomCel = "R"
    Call RecuperationComplete(typeA, nomCel, formA)
    chbValiderR36.Value = False
    Range("R35").Value = Date
End If
 
Windows("exemple.xls").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
 
Application.ScreenUpdating = True
 
End Sub

Voici mon code en entier...

Merci pour ton aide Gorfael je vais essayer ta solution et je vous tient au courant.

Pierre : Dans la cellule N39 ... l'utilisateur a la possibilité de sélectionner un intitulé de colonne, et j'aimerai que ce ne soit pas possible... qu'il ne puisse pas changer le contenu de cette cellule de quelque façon que ce soit...

J'ai mis en place ton code qui fonctionne à peu près... En effet si c'est la cellule N36 j'aimerai que seule la cellule N39 soit bloquée... et réciproquement pour O36, P36, Q36, R36... Et là cela me bloque tout d'un coup...
Pourrais tu m'expliquer un peu ton code... Je débute en vb et j'ai un peu de mal à comprendre le code des autres lol...

Petite précision ... Ce code doit fonctionner quand j'ai une date en N35 ... et réciproquement O35, P35, Q35, R35...

13/09/2010, 09h40
Gorfael

Salut juju1988 et le forum
Il faut garder à l'esprit que si le demandeur connaît son besoin, le dépanneur ne peut se fier qu'à ce qui est inscrit dans les postes. Et que s'il y a deux interprétations possibles, la loi de Murphy nous rappelle que ce ne sera pas la bonne intuition qui prévaudra.

Ce que je crois comprendre :
Pour les colonnes O à R, si la ligne 35 contient une date, il faut interdire la sélection, colonne par colonne de la ligne 39.
A+
13/09/2010, 09h45
juju1988

Oui je suis désolée c'était la fin de la journée la semaine dernière je n'avais plus les yeux en face des trous et n'ai pas été assez claire :D désolée...

Oui c'est ça si c'est en N35 qu'il y'a une date il faut interdire la sélection/modification en N39
Si c'est en O35 qu'il y a une date il faut interdire la sélection/modification en O39...
Et ainsi de suite pour P35/P39, Q35/Q39, R35/R39...

Salut juju1988 et le forum
Ma macro modifiée et renseignée :
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 Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error GoTo Sel_Erreur 'si excel détecte une erreur, aller à l'adresse Sel_Erreur 'Déclaration des variables --------------------------------- Dim Plage As Range, Cel As Range 'MEI ------------------------------------------------------- Application.EnableEvents = False ' Blocage de la gestion des évènements 'Traitement ------------------------------------------------ If Not (Intersect(Target, Range("N39:R39")) Is Nothing) Then 'si la sélection contient des cellule de la plage N39:R39, alors For Each Cel In Target 'Pour chaque cellule appartenant à la sélection If Intersect(Cel, Range("N39:R39")) Is Nothing Or (Not (IsDate(Cel.Offset(-4, 0)))) Then 'si la cellule n'appartient pas à la plage N39:R39 ou que la cellule à 4 ligne avant '(39-4=35) ne contient pas une date If Plage Is Nothing Then Set Plage = Cel Else Set Plage = Union(Plage, Cel) End If 'la stocker dans la variable "Plage" Else 'sinon (cel appartient à N39:R39, et la cellule en ligne 35 est une date) If Plage Is Nothing Then Set Plage = Cel.Offset(1, 0) Else Set Plage = Union(Plage, Cel.Offset(1, 0)) End If 'stocker la cellule de la ligne au-dessus dans la variable "Plage" End If Next Cel 'cellule suivante Plage.Select 'sélectionner Les cellules de "Plage" End If 'Sortie obligatoire ------------------------------------------- Sel_Sortie: Application.EnableEvents = True 'Remettre en route la gestion des évènements Exit Sub 'sortir de la macro 'Gestion des erreurs ------------------------------------------ Sel_Erreur: MsgBox Err.Description, vbOKOnly, "erreur n°" & Err.Number 'Boîte d'alerte numéro+description de l'erreur Resume Sel_Sortie 'continuer la macro en allant à la sortie obligatoire End Sub
Je pourrait la faire plus simple, mais tu risquerais d'avoir des erreurs intempestives. Il y a quelques cas que je ne traite pas : une multi-sélection incluant les cellules de N39 à R39 et des cellules des lignes 1 à 4. On peut toujours les traiter, mais est-ce réellement nécessaire ?

Gestion des erreurs : comme je bloque la gestion des évènements, elle est obligatoire => si Excel détecte une erreur après le blocage, il sort de la macro, après la ligne de code en erreur (avec message, bien entendu). Mais la macro ne repasse donc pas sur la remise en route de la gestion des évènements. Pour éviter cela, on intercepte la gestion des erreurs, on la gère, et on fait sortir de la macro par une seule sortie, qui remet en route la gestion des évènements.
La seule question à se poser, c'est si le blocage est réellement nécessaire. Comme je ne sais pas comment doit être utilisé le classeur, je préfère le faire, même si ne pas le faire ne ferait que doubler la sélection : la première fois, elle change les cellules de la plage O39:R39 en O40:R40, (donc changement de sélection) la seconde fois (à Plage.select), elle ne change pas la sélection, et ne relance pas la macro.

Stockage en variable "Plage" : Comme j'utilise l'instruction Union pour ajouter Cel à Plage, je fais un test avant pour savoir si plage contient quelque chose. Si c'est le cas : Plage=Plage+Cel, mais si elle ne contient rien, ce type d'instruction déclenche une erreur, alors je fait un silple Plage=Cel.

Comme je ne travaille pas avec le fichier, j'essaie de me garantir de toutes les erreurs probables : je parts donc du principe que tu peux faire une multi-sélection, incluant ou non la plage concernée.
Il faudrait aussi m'affranchir du cas ou tu sélectionnes des cellules de N39:R39 et en même temps des cellules des lignes 1 à 4 => ce qui déclenche une erreur à l'instruction Cel.Offset(-4,0), celle si pointant la ligne -4. mais c'est un cas de figure possible, mais à priori improbable. Sinon, il faut refaire un test supplémentaire de stockage dans la variable "Plage", mais ça allonge le code, alors que ça ne me semble pas réellement nécessaire.

Je pourrais travailler le code de stockage de la Variable Cel dans Plage en sous-programme : mais l'appel à une autre macro fait perdre du temps, alors que le traitement ne nécessite qu'un seul test. Donc, j'ai recopié le bout de code.
A+

13/09/2010, 13h42
juju1988

Merci cela fonctionne parfaitement!!:D

Re Bonjour,

J'ai changé un peu mon code et du coup la macro que tu m'as donné me fait quelques bugs.
J'ai en fait des Liens hypertextes (ligne 40) crées à l'ouverture et lorsque que je clique dessus cela m'ajoute la valeur Sieving dans la première cellule vide en ligne 39 et me récupère en ligne 41 la valeur d'une des cellules de la colonne sur lequel se trouve mon lien hypertexte.
Seulement avec la macro en place cela ne m'ajoute pas à la première colonne vide mais bien plus loin et pas en ligne 41 mais en ligne en dessous...

Comment puis-je faire?

Voici mes codes création liens hypertextes

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Workbook_Open()
 With Worksheets(1)
    .Hyperlinks.Add .Range("G40"), "", SubAddress:="G40", TextToDisplay:="Nécessite Sieving"
    .Hyperlinks.Add .Range("J40"), "", SubAddress:="J40", TextToDisplay:="Nécessite Sieving"
    .Hyperlinks.Add .Range("K40"), "", SubAddress:="K40", TextToDisplay:="Nécessite Sieving"
    .Hyperlinks.Add .Range("M40"), "", SubAddress:="M40", TextToDisplay:="Nécessite Sieving"
    .Hyperlinks.Add .Range("N40"), "", SubAddress:="N40", TextToDisplay:="Nécessite Sieving"
    .Hyperlinks.Add .Range("O40"), "", SubAddress:="O40", TextToDisplay:="Nécessite Sieving"
    .Hyperlinks.Add .Range("P40"), "", SubAddress:="P40", TextToDisplay:="Nécessite Sieving"
    .Hyperlinks.Add .Range("Q40"), "", SubAddress:="Q40", TextToDisplay:="Nécessite Sieving"
    .Hyperlinks.Add .Range("R40"), "", SubAddress:="R40", TextToDisplay:="Nécessite Sieving"
End With
 
End Sub

Code sur liens :

Code:

1
2
3
4
5
6
7
Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim nomCel As String
nomCel = Target.SubAddress
 
    Call recupNumCmdTttEtPremCel(nomCel)
 
End Sub

recupNumCmdTttEtPremCel

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
 
'Procédure qui permet de de placer dans la première cellule vide en ligne 39 et de lui faire prendre la valeur Sieving et de récupérer
'le numéro de commande de traitement associé à la colonne sur laquelle on a effectué un clic bouton
Sub recupNumCmdTttEtPremCel(nomCel As String)
Dim recupNumCmdTtt As String
Dim NbCellule As Integer
recupNumCmdTtt = ""
NbCellule = 0
nomCel = Left(nomCel, 1)
Windows("analyses4.xls").Activate
Range("A39").Select
Do While i < 18
    For i = 2 To 18
        If Cells(39, i) <> "" Then
            Windows("analyses4.xls").Activate
            Range("A39").Select
            Do While Not (IsEmpty(ActiveCell))
                NbCellule = NbCellule + 1
                Selection.Offset(0, 1).Select
            Loop
        End If
    Next i
Loop
ActiveCell.Value = "Sieving"
recupNumCmdTtt = Range(nomCel & "37").Value
ActiveCell.Offset(2, 0).Range("A1").Select
ActiveCell.Value = recupNumCmdTtt
 
End Sub

Procédure Valider Autres qui permet d'appeler la procédure qui compare la colonne où se trouve lien hypertexte et celle rajoutée Sieving

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
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
 
 
Private Sub Valider_Final_Autre_Click()
 
Dim typeA As String
Dim formA As Integer
Dim nomCel As String
Dim colBouton As Integer
 
 
Application.ScreenUpdating = False
 
Call Ouvre
 
'Attribution type analyse en fonction de la sélection du traitement
If Range("E4") = "Régénération" Then
    typeA = "Régé"
ElseIf Range("E4") = "React" Then
    typeA = "React"
ElseIf Range("E4") = "Valorisation" Then
    typeA = "Valorisation"
ElseIf Range("E4") = "Recyclage" Then
    typeA = "Recyclage"
ElseIf Range("E4") = "Présulfuration" Then
    typeA = "Presulf"
ElseIf Range("E4") = "Régé + React" Then
    typeA = "Régé + React"
Else
    typeA = "Régé + Présulf"
End If
 
formA = 4
 
 
If Range("N35").Value = True Then
    nomCel = "N"
    If InStr(Range("N39").Value, "Sieving") = 0 Then
        Call RecuperationComplete(typeA, nomCel, formA)
    Else
        colBouton = recupNomCol(nomCel)
        Call RecupSieving(colBouton, nomCel, formA, typeA)
    End If
        chbValiderN35.Value = False
        Range("N36").Value = Date
 
ElseIf Range("O35").Value = True Then
    nomCel = "O"
    If InStr(Range("O39").Value, "Sieving") = 0 Then
        Call RecuperationComplete(typeA, nomCel, formA)
    Else
        colBouton = recupNomCol(nomCel)
        Call RecupSieving(colBouton, nomCel, formA, typeA)
    End If
        chbValiderO35.Value = False
        Range("O36").Value = Date
ElseIf Range("P35").Value = True Then
    nomCel = "P"
    If InStr(Range("P39").Value, "Sieving") = 0 Then
        Call RecuperationComplete(typeA, nomCel, formA)
    Else
        colBouton = recupNomCol(nomCel)
        Call RecupSieving(colBouton, nomCel, formA, typeA)
    End If
        chbValiderP35.Value = False
        Range("P36").Value = Date
ElseIf Range("Q35").Value = True Then
    nomCel = "Q"
    If InStr(Range("Q39").Value, "Sieving") = 0 Then
        Call RecuperationComplete(typeA, nomCel, formA)
    Else
        colBouton = recupNomCol(nomCel)
        Call RecupSieving(colBouton, nomCel, formA, typeA)
    End If
        chbValiderQ35.Value = False
        Range("Q36").Value = Date
ElseIf Range("R35").Value = True Then
    nomCel = "R"
    If InStr(Range("R39").Value, "Sieving") = 0 Then
        Call RecuperationComplete(typeA, nomCel, formA)
    Else
        colBouton = recupNomCol(nomCel)
        Call RecupSieving(colBouton, nomCel, formA, typeA)
    End If
        chbValiderR35.Value = False
        Range("R36").Value = Date
End If
 
Windows("exemple.xls").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
'
Application.ScreenUpdating = True
 
End Sub

Procédure de validation comparaison

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
64
65
66
67
68
69
70
71
72
73
74
75
Function RecupSieving(colBouton As Integer, nomCel As String, formA As Integer, typeA As String)
 
Dim recupVar As String
Dim recupVal As String
recupVar = ""
recupVal = ""
 
 
Do While i < cNumLigneFinTableau
    For i = cNumLigneDebutTableau To cNumLigneFinTableau
        Windows("analyses4.xls").Activate
        If Cells(i, colBouton) <> "" Then
            Windows("exemple.xls").Activate
            'Sélectionne la première cellule du tableau
            Range("A2").Select
 
            'Boucle pour se positionner sur la première cellule vide
            Do While Not (IsEmpty(ActiveCell))
                NbLigne = NbLigne + 1
                Selection.Offset(1, 0).Select
            Loop
 
            'Première cellule on met la forme d'analyse (numéro dans Waste)
            ActiveCell.Value = formA
            '
            'Cellule suivante On récupère le numéro de lot
            ActiveCell.Offset(0, 1).Range("A1").Select
            Call recupNumLot
 
            ActiveCell.Interior.Color = RGB(255, 255, 255)
 
            'Cellule suivante On récupère le type d'analyse
            ActiveCell.Offset(0, 1).Range("A1").Select
            ActiveCell.Value = typeA
 
            'Cellule suivante On récupère la variable d'analyse
            ActiveCell.Offset(0, 1).Range("A1").Select
 
            Windows("analyses4.xls").Activate
            recupVar = Range("A" & i).Value
            Windows("exemple.xls").Activate
            ActiveCell.Value = recupVar
 
            'Cellule suivante On récupère la valeur de la mesure
            ActiveCell.Offset(0, 1).Range("A1").Select
 
            Windows("analyses4.xls").Activate
 
            If Range(nomCel & i).Value <> "" Then
                Windows("analyses4.xls").Activate
                recupVal = Range(nomCel & i).Value
                Windows("exemple.xls").Activate
                ActiveCell.Value = recupVal
            Else
 
                Windows("analyses4.xls").Activate
                recupVal = Cells(i, colBouton).Value
                Windows("exemple.xls").Activate
                ActiveCell.Value = recupVal
            End If
 
            'Cellule suivante On récupère le numéro de commande traitement
            ActiveCell.Offset(0, 1).Range("A1").Select
 
            Windows("analyses4.xls").Activate
            RecupNumCmdTraitement = Range(nomCel & cNumLigneCmdTraitement).Value
            Windows("exemple.xls").Activate
            ActiveCell.Value = RecupNumCmdTraitement
 
        End If
    Next i
Loop
 
 
End Function