Pb protection feuille avec une macro contrôle des doublons

Fermé
GIBO35 - 11 déc. 2012 à 21:57
 GIBO35 - 12 déc. 2012 à 09:39
Bonsoir,
Après quelques heures de recherche et l'aide d'amis j'ai enfin pu finaliser la macro me permettant de faire des contrôles de doublons dans des colonnes différentes.
(Voir ci-après). Elle fonctionne correctement. Le seul souci c'est qu'elle enlève la protection de la feuille dès la première saisie dans une cellule d'une des colonnes intéressées. Conséquence, l'utilisateur peut écraser des données ou formules présentes dans la feuille par inadvertance.
J'ai fait un test en retirant la macro,. La protection reste activée après la saisie, ce qui confirme que le problème est bien lié à cette macro.
Quelqu'un aurait il une solution à me proposer, je ne trouve rien dans les différents forums.
Avec mes remerciements anticipés.



GIBO35

Versions excel utilsées : Excel XP Pro, Excel 2003, Excel 2007, Excel 2010.



Private Sub Worksheet_change(ByVal Target As Range)

Dim vCol As Integer
Dim vRéponse As Integer
Dim vCellule As Object
If Target.Columns.Count > 1 Or Target.Rows.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
vCol = Target.Column
Dim val As String
val = ""
If vCol = 10 Then
val = "J:J"
ElseIf vCol = 23 Then
val = "W:W"
ElseIf vCol = 35 Then
val = "AI:AI"
Else
Exit Sub
End If
For Each vCellule In Range(val)
If LCase(vCellule.Value) = LCase(Target.Value) And vCellule.Address <> Target.Address Then
vRéponse = MsgBox("Ce concurrent figure déjà dans l'ordre d'arrivée." & Chr(10), vbOKOnly + vbCritical, "DOUBLON")
If vRéponse = vbOK Then
Range(Target.Address).Activate
'SendKeys "{F2}"
Target.Value = ""
End If
Exit Sub
End If
If vCellule.Row > ActiveCell.SpecialCells(xlLastCell).Row Then Exit Sub

Next
ActiveSheet.Protect
A voir également:

1 réponse

Bonjour,
Vous l'avez sans doute compris le code que j'avais joint dans mon précédent message n'était pas le bon (je les ai modifiés plusieurs fois pour essayer de trouver seul la solution !) Veuillez accepter mes excuses. Il faut dire que je ne suis pas un expert en excel...ni même en informatique d'ailleurs ! et je crois que mon apprentissage est loin de se terminer...enfin on y croit.
Dans la macro ci-après, on peut voir que la feuille est déprotégée systématiquement par le code mais a priori la macro ne fonctionne que si la feuille est déprotégée.
J'ai donc pensé que celà provenait du fait que dans mes colonnes J, W, AI j'avais également des cellules protégées, celles ci interdisant le contrôle des doublons. J'ai donc déprotégées toutes les cellules de ces colonnes et modifier la macro (suppression des lignes relatives à la déprotection). Sans résultat, j'ai des messages d'erreur qui me renvoient à la ligne:
If vCellule.Row > ActiveCell.SpecialCells(xlLastCell).Row Then.
Il ne me reste plus qu'à trouver la solution à ce problème pour finaliser mon projet, si vous pouviez m'aider, ce serait "top". Merci.
En attendant, je vous souhaite de passer une bonne, voire une excel(lente) journée.

GIBO35



Private Sub Worksheet_change(ByVal Target As Range)
Dim mdp As String
mdp=Sheets("feuil1").Range("A1").Value
ActiveSheet.Unprotect mdp
Dim vCol As Integer
Dim vRéponse As Integer
Dim vCellule As Object
If Target.Columns.Count > 1 Or Target.Rows.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
vCol = Target.Column
Dim val As String
val = ""
If vCol = 10 Then
val = "J:J"
ElseIf vCol = 23 Then
val = "W:W"
ElseIf vCol = 35 Then
val = "AI:AI"
Else
Exit Sub
End If
For Each vCellule In Range(val)
If LCase(vCellule.Value) = LCase(Target.Value) And vCellule.Address <> Target.Address Then
vRéponse = MsgBox("Ce concurrent figure déjà dans l'ordre d'arrivée." & Chr(10), vbOKOnly + vbCritical, "DOUBLON")
If vRéponse = vbOK Then
Range(Target.Address).Activate
'SendKeys "{F2}"
Target.Value = ""
End If
Exit Sub
End If
If vCellule.Row > ActiveCell.SpecialCells(xlLastCell).Row Then Exit Sub
Next
ActiveSheet.Protect mdp
0