[XL-2000] Verrouillage de cellules

[cobra38]

Bonjour à Tous ,

Un petit coup de main me serait très utile pour me permettre
de verrouiller l'écriture dans une série de cellules comportant entre autres des formules à protéger ou des données
j'ai vainement tenté cela mais malgré l'avertissement les cellules sont ecrites et je perds toute la dissuasion recherchée

Code :

1
2
3
4
5
6
7
8
9
10
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
Dim vligneder As Long
vligneder = [A65535].End(xlUp).Row
If Intersect(Target, Range("J7", "P" & vligneder)) Is Nothing Then Exit Sub
   For Each Cel In Intersect(Target, Range("J7", "P" & vligneder))
        MsgBox " On ne peut pas modifier le contenu !"
   Next Cel
End Sub

Il s'agit donc d'interdire l'ecriture dans une zone "J7" à "P.."

Merci par avance pour votre aide
A++

[Ormonth]

Bonjour,

La procédure normale est de dévérouiller en protection les cellules qu'on veut pouvoir écrire et de protéger la feuille ensuite...

il y a plein d'exemple sur le forum,

à voir...

cordialement,

didier

[cobra38]

Salut Ormonth

Justement mon problème est de passer par du VBA et non pas
un verrouillage classique de feuille car j'ai dans ma feuille , une ligne de filtre
et dès que je verouille mes cellules je perds la fonction de ma ligne de filtre
J'ai bien sûr recherché sur le forum le code et je n'ai pas trouver
mon bonheur

A++

[laetitia]

bonjour cobra38 Ormonth le forum tu peus tenter un truc dans ce genre ??

Code :

1
2
3
4
5
6
7
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Not Application.Intersect(Target, Range("J7", "P" & [A65535].End(xlUp).Row)) Is Nothing Then
 Protect Password:="toto"
 Else
 Unprotect Password:="toto"
 End If
End Sub

[cobra38]

Bonjour à Toutes et Tous

laetitia
j'ai tenté effectivement et cela fonctionne
tant je ne veux pas ecrire dans la zone concernée
mais....
En fait, je passe par un USF qui me remplit les données dans la zone concernée et si je mets la protection là çà plante
il faut l'enlever avant mise à jour et ensuite la remettre ( cf Ormonth)
mais là où je ne pige pas c'est que je suis sous mon USF au moment de valider mes données alors que la protection elle s'effectue dans la feuille ( sheets )
comment déproteger lorsque je suis sous mon USF ?

A++

[laetitia]

re, il faut appliquer le meme principe. suppose un bouton pour valider dans ton user
un exemple simple 2 textbox copier dans la feuille

Code :

1
2
3
4
5
6
7
Private Sub valider_Click()
 Sheets(1).Unprotect Password:="toto"
 [j9] = TextBox1.Value
 [j10] = TextBox2.Value
 'ton code
 Sheets(1).Protect Password:="toto"
End Sub

[Ormonth]

Bonjour,

Euh Laetitia t'as donné la solution, il faut essayer de la décrypter et de l'adapter, il a 36 façons genre tu peux faire deux procédures et y faire appel quand il en est besoin :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub ProtectF()
Dim objFeuillP As Worksheet
 
Application.ScreenUpdating = False
For Each objFeuillP In ThisWorkbook.Worksheets
    objFeuillP.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=gvstrMotProtect
    objFeuillP.EnableSelection = xlNoSelection
Next
Application.ScreenUpdating = True
Set objFeuillP = Nothing
End Sub

Sub NoProtectF()
Dim objFeuillP As Worksheet

Code :

1
2
3
4
5
6
7
Application.ScreenUpdating = False
For Each objFeuillP In ThisWorkbook.Worksheets
    objFeuillP.Unprotect Password:=gvstrMotProtect
Next
Application.ScreenUpdating = True
Set objFeuillP = Nothing
End Sub

gvstrMotProtect est une variable contenant le mot de passe.

cordialement,

Didier

[cobra38]

Encore Merci à tous les deux

Effectivement le solution à laetitia me semble pour le novice que je suis
plus abordable ...
par contre l'autre solution demande plus d'attention car elle presente un avantage certain de pouvoir être integrée dans l'ensemble d'un projet
A retenir donc precieusment
néanmoins j'ai besoin votre éclairage car dans la solution de laetitia
je me retrouve avec une erreur "1004" ôter la protection etc...
à la ligne :

Code :

Range(Cells(NoLig, "A"), Cells(NoLig, "S")).ClearContents

malgre la presence au préalable de la ligne :

Code :

Rec.Unprotect PassWord:="GSR"

( rec étant le label de la feuille )
car dans mon code j'effectue lors d'un ajout :
1 ) l'ajout de la ligne precedente
2 ) puis ensuite le "clear" de celle-ci



A++

[laetitia]

re, pas trop compris rec label dans feuille ou userform ??? l'ideal met ton code en entier

[cobra38]

Voilà le code du bouton "Valider"

Je reclame indulgence c'est un premier essai ......

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
'---- Bouton valider -----
Private Sub CO_Valid_Click()
Dim msg$, i As Byte, c As Range, j As Byte, ess As Long
Dim Tablo As Variant, Valeur(16), Ordre
Sheets("CO").Activate

NoLig = Rec.Range("A65535").End(xlUp).Row + 1 'No de la première ligne vide

'--- Tableau des Mises à Jour -----
Tablo = Array("Le Nom de l'Entreprise", "Le N° Commande", "Le N° Bon", "Le N° Ligne Mère", "Le Nom du CA", "La Date sur le Calendrier", "La Désignation", "Le Crédit", "La Somme allouée")
Ordre = Array(0, 1, 2, 3, 4, 5, 6, 7, 8)
    Valeur(0) = ListBox1.Text 'Entreprise
    Valeur(1) = ListBox2.Text 'Commande
    Valeur(2) = TextBox3.Value 'Bon
    Valeur(3) = ListBox9.Value 'N° Ligne mere
    Valeur(4) = ListBox5.Text ' Nom du CA
    Valeur(5) = CalendarCO.Value ' Date
    Valeur(6) = TextBox7.Text ' Designation
    Valeur(7) = ListBox8.Text ' Credit
    Valeur(8) = TextBox9.Value ' Somme
 

For i = 0 To 8
    If Valeur(i) = Empty Then
       MsgBox "Saisir " & Tablo(i), vbCritical, "Données incomplètes"
       'Me.Controls(Ordre(i)).SetFocus
       Exit Sub
    End If
Next

'----------- Test des caractères numériques -----
If Not IsNumeric(Valeur(2)) Then
     MsgBox "Vous devez saisir des valeurs numériques pour le N° de BON", vbOKOnly, "Erreur"
     TextBox3.SetFocus
Exit Sub
End If

If Not IsNumeric(Valeur(3)) Then
     MsgBox "Vous devez saisir des valeurs numériques pour le N° de Ligne PNU", vbOKOnly, "Erreur"
     ListBox9.SetFocus
Exit Sub
End If

'------- test des Champs des combox ----
If Valeur(3) = 0 Then
   MsgBox "Vous devez saisir un N° de Ligne PNU", vbOKOnly, "Erreur"
   ListBox9.SetFocus
Exit Sub
End If

If Valeur(8) = 0 Then
   MsgBox "Vous devez saisir une Somme", vbOKOnly, "Erreur"
   TextBox9.SetFocus
Exit Sub
End If

'------------ Mise à jour de la somme à partir de la liste des Credits ---
For i = 0 To 6
  If ListBox8.List(i) <> Empty And ListBox8.List(i, 0) = ListBox8.Text Then
       Valeur(9) = ListBox8.List(i, 1)
  End If
Next
'------------ Mise à Jour de l'Adresse -----
NoLig = Rec.Range("A65535").End(xlUp).Row + 1 'No de la première ligne vide
Lig = ActiveCell.Row

Rec.Unprotect PassWord:="GSR"
'--------- Copie de la ligne precedente et clear -------
Range(Cells(Lig, "A"), Cells(Lig, "S")).Copy Destination:=Cells(NoLig, "A")
Range(Cells(NoLig, "A"), Cells(NoLig, "S")).ClearContents
Cells(NoLig, "G") = "En Cours"
Cells(NoLig, "H") = 0
'---------Mise à Jour des données ------

i = 0
For i = 1 To 6
 Rec.Cells(NoLig, i) = Valeur(i - 1)
Next
Rec.Cells(NoLig, 9) = Valeur(6)
'------------- Mise à jour Somme ----------
Rec.Cells(NoLig, 10 + Valeur(9)) = Valeur(8)

Unload Crea_Bon
Rec.Protect PassWord:="GSR"
End Sub

J'ai en gras dans le code là où çà plante.....

A++

[laetitia]

re,si tu mets le nom de la feuille cela devrait marcher je sais toujours pas ce que sait REC??

Code :

1
2
3
Sheets("CO").Unprotect Password:="GSR"
 'ton code
 Sheets("CO").Protect Password:="GSR"

[cobra38]

rec , c'est çà ()

Code :

Set Rec = Worksheets("CO")

A++

[Qwazerty]

Salut (Coucou Leti)
As tu essayé en mode pas a pas (touche F8) lorsque tu execute la ligne

Code :

Rec.Unprotect PassWord:="GSR"

Si tu vas dans ta feuille CO, la protection est toujours active ou pas?

Dans ton code tu ne définis Rec nul part?
Si tu la définis ailleur pourquoi faire

Code :

Sheets("CO").Activate

Autant faire

Code :

Rec.activate

Le mieux etant encore de ne pas l'activer la feuille et de faire référence a Rec (s'il est bien défini) a chaque fois, comme tu commencais a le faire ici

Code :

NoLig = Rec.Range("A65535").End(xlUp).Row + 1 'No de la première ligne vide

Il serait donc logique de le faire partout, ce qui éviterais d'avoir une autre fenêtre active lors de l'exécution d'un code censé agir sur le feuille représentant Rec.

Code :

1
2
3
4
5
6
7
8
With Rec
    .Unprotect Password:="GSR"
    '--------- Copie de la ligne precedente et clear -------
    .Range(.Cells(Lig, "A"), .Cells(Lig, "S")).Copy Destination:=.Cells(NoLig, "A")
    .Range(.Cells(NoLig, "A"), .Cells(NoLig, "S")).ClearContents
    .Cells(NoLig, "G") = "En Cours"
    .Cells(NoLig, "H") = 0
End With

Car ne pas préciser de feuille revient a utiliser la feuille active, donc attention.
A++
Qwaz
(Bisous Leti)

[cobra38]

Bonjour à Tous

Désolé mais çà se plante toujours au même endroit à la ligne :

Code :

 .Range(.Cells(NoLig, "A"), .Cells(NoLig, "S")).ClearContents

j'ai pourtant bien déclaré ma feuille

Code :

1
2
Dim Rec As Worksheet
Set Rec = Worksheets("CO")

j'ai mis :

Code :

1
2
3
4
5
6
7
8
With Rec
    .Unprotect PassWord:="GSR"
    '--------- Copie de la ligne precedente et clear -------
    .Range(.Cells(Lig, "A"), .Cells(Lig, "S")).Copy Destination:=.Cells(NoLig, "A")
    .Range(.Cells(NoLig, "A"), .Cells(NoLig, "S")).ClearContents
    .Cells(NoLig, "G") = "En Cours"
    .Cells(NoLig, "H") = 0
End With

par contre ma protection est dans ma feuille "CO"

Code :

1
2
3
4
5
6
7
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Not Application.Intersect(Target, Range("J7", "P" & [A65535].End(xlUp).Row)) Is Nothing Then
   Protect PassWord:="GSR"
 Else
   Unprotect PassWord:="GSR"
 End If
End Sub

Je ne comprends pas où çà cloche (?)
Tout se passe comme si il ne voulais pas déprotéger la feuille "CO" au moment de l'ecriture d'une nouvelle ligne

help !!!

A++