problème suite à la protection des feuilles Excel

Le
COQUITO
Bonjour à tous,

Le problème rencontré est le suivant :
Sur un onglet de classeur, il existe des listes déroulantes à saisie
semi-automatique qui doivent permettrent à des utilisateurs (comptables) de
saisir ligne à ligne des écritures.

L'une de ces listes est construite dynamiquement dans la procédure
évènementielle "Private Sub Worksheet_SelectionChange(ByVal target as Range)
sur la colonne 5 de l'onglet.
L'utilisateur sélectionne un compte dans cette liste (jusque là la saisie
semi automatique fonctionne très bien : c'est à dire que l'utilisateur peut
taper "A121" dans la zone de liste et tous les comptes commençant par ces 4
caractères apparaissent dans la liste déroulante).

Cette sélection d'un compte renvoie alors sur la procédure évènementielle
"Private Sub Worksheet_Change(ByVal target as Range)".
Dans cette procédure, par le biais du test "If target.column = 5", le code
- vérifie que le compte choisi est bien dans la liste (contrôle fait par
VBA puisque dans le cas de zone de validation à saisie semi automatique, il
faut décocher l'option "quand les données.." de l'onglet Alerte Message
de la fenêtre de validation, et donc il n'existe plus de contrôle de
validité)
- et copie sur la ligne de la cellule active (target) toutes les
formules et autres listes déroulantes qui se trouvent sur la ligne 1 de
l'onglet qui sert de "ligne modèle"

Sur l'onglet, certaines colonnes sont protégées (P à U et W à X).
La protection de ces plages est effectuée dès que l'utilisateur sélectionne
la feuille, donc dans la procédure évènementielle "Private Sub
Worksheet_Activate".

Je déprotège la feuille dans la procédure Worksheet_SelectionChange pour que
la liste déroulante contenant les comptes puisse se créer (bien que la
colonne 5 ne fasse pas partie des plages protégées ; c'est déjà quelque
chose que je ne comprends pas bien ??).

Je déprotège également la feuille dans le corps de la procédure
Worksheet_Change, juste avant que soient recopiées toutes les listes
déroulantes et formules en provenance la ligne modèle (ligne 1).

Tout ce la se déroule normalement.
MAIS, le problème apparait ensuite car l'utilisateur doit aussi utiliser les
autres listes déroulantes qui ont été recopiées depuis la ligne modèle et à
ce moment là, on se rend compte que la saisie semi-automatique ne marche
plus du tout sur ces listes là.

Dans la procédure Worksheet_Change, j'avais introduis les mêmes contrôle de
validité sur ce qui est saisi dans chacune des listes déroulantes à saisie
semi auto (col 2, col8, col9), avec une MsgBox "L'élément xxxx n'existe
pas".
Tout cela fonctionnait bien avant que j'introduise la protection des
cellules.
Maintenant, sur ces listes autres que celle de la colonne 5, la saisie semi
automatique ne marche plus, le contrôle de validité non plus.

De PLUS, je constate que lorsque la souris est au-dessus de la cellule, il
y a la "petite main" comme au dessus des boutons affectés à une macro au
lieu d'avoir la "croix" classique.

Voici le code que j'ai utilisé :

Option Explicit

Private Sub Worksheet_Activate()

With ActiveSheet
.Unprotect
.Cells.Locked = False
.Cells.FormulaHidden = False
.Cells.Range("P3:U100,W3:X672").Locked = True
.EnableSelection = xlUnlockedCells
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, UserInterfaceOnly:=True
.ScrollArea = Range("E65536").End(xlUp).Offset(1, 0)
End With

End Sub


Private Sub Worksheet_Change(ByVal target As Range)
Dim rCel As Range
Dim rValCherchee As Range
Dim rPlage As Range


Application.EnableEvents = False
If target.Column = 2 Then
If target <> "" Then
Set rValCherchee = [vecteur_Entit].Find(target.Value,
LookAt:=xlWhole)
If rValCherchee Is Nothing Then
MsgBox "L'entité " & Range("B" & target.Row).Value & "
n'existe pas"
Application.Undo
End If
End If
ElseIf target.Column = 5 Then
If target <> "" Then
Set rValCherchee = [vecteur_Compte].Find(target.Value,
LookAt:=xlWhole)
If rValCherchee Is Nothing Then
MsgBox "Le compte " & Range("E" & target.Row).Value & "
n'existe pas"
' Application.EnableEvents = False
Application.Undo
' Application.EnableEvents = True
Else
'Copie les formules et les listes déroulantes (dont on
efface le contenu
'sélectionné sur la ligne modèle)
Application.EnableEvents = False
ActiveSheet.Unprotect
Range("A1").Copy
Range("A" & target.Row).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("B1").Copy
Range("B" & target.Row).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("B" & target.Row).ClearContents
Range("F1:J1").Copy
Range("F" & target.Row).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("G" & target.Row & ":J" &
target.Row).ClearContents
Range("M1").Copy
Range("M" & target.Row).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("M" & target.Row).ClearContents
Range("P1:U1").Copy
Range("P" & target.Row).Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Refait les bordures des cellules sans formules
Set rPlage = Range("C" & target.Row & ":E" & target.Row)
With rPlage.Borders
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Item(xlEdgeLeft).Weight = xlThin
.Item(xlEdgeTop).Weight = xlThin
.Item(xlEdgeBottom).Weight = xlThin
.Item(xlEdgeRight).Weight = xlThin
.Item(xlInsideVertical).Weight = xlThin
End With
Set rPlage = Range("K" & target.Row & ":L" & target.Row)
With rPlage.Borders
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Item(xlEdgeLeft).Weight = xlThin
.Item(xlEdgeTop).Weight = xlThin
.Item(xlEdgeBottom).Weight = xlThin
.Item(xlEdgeRight).Weight = xlThin
.Item(xlInsideVertical).Weight = xlThin
End With
Set rPlage = Range("N" & target.Row & ":O" & target.Row)
With rPlage.Borders
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Item(xlEdgeLeft).Weight = xlThin
.Item(xlEdgeTop).Weight = xlThin
.Item(xlEdgeBottom).Weight = xlThin
.Item(xlEdgeRight).Weight = xlThin
.Item(xlInsideVertical).Weight = xlThin
End With
Set rPlage = Range("P" & target.Row & ":U" & target.Row)
rPlage.Locked = True
ActiveSheet.Protect DrawingObjects:=True,
Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True,
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, UserInterfaceOnly:=True
' Calculate
End If
End If
ElseIf target.Column = 8 Then
If target <> "" Then
Set rValCherchee = [vecteur_Entit].Find(target.Value,
LookAt:=xlWhole)
If rValCherchee Is Nothing Then
MsgBox "L'entité " & Range("H" & target.Row).Value & "
n'existe pas"
Application.Undo
End If
End If
ElseIf target.Column = 9 Then
If target <> "" Then
Set rValCherchee = [vecteur_Entit].Find(target.Value,
LookAt:=xlWhole)
If rValCherchee Is Nothing Then
MsgBox "L'entité " & Range("I" & target.Row).Value & "
n'existe pas"
End If
End If
End If
Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal target As Range)

If target.Column = 5 And target.Row <> 2 And target.Count = 1 Then
ActiveSheet.Unprotect
Range("E" & target.Row).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=
_
xlBetween, Formula1:="=RechercheCpte2"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
End If

End Sub

Peut-être que quelqu'un parmi vous aura une idée sur la question.
Je vous remercie par avance de l'aide que vous pourriez m'apporter.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel.C
Le #21533181
Bonjour.
Ce serait bien si tu pouvait poser un classeur exemple sur
www.cijoint.fr, après avoir effacé les données confidentielles. Pposte
ensuite le lien généré.
Indique aussi les manips conduisant au problème évoqué.
Cordialement.
Daniel

Bonjour à tous,

Le problème rencontré est le suivant :
Sur un onglet de classeur, il existe des listes déroulantes à saisie
semi-automatique qui doivent permettrent à des utilisateurs (comptables) de
saisir ligne à ligne des écritures.

L'une de ces listes est construite dynamiquement dans la procédure
évènementielle "Private Sub Worksheet_SelectionChange(ByVal target as Range)
sur la colonne 5 de l'onglet.
L'utilisateur sélectionne un compte dans cette liste (jusque là la saisie
semi automatique fonctionne très bien : c'est à dire que l'utilisateur peut
taper "A121" dans la zone de liste et tous les comptes commençant par ces 4
caractères apparaissent dans la liste déroulante).

Cette sélection d'un compte renvoie alors sur la procédure évènementielle
"Private Sub Worksheet_Change(ByVal target as Range)".
Dans cette procédure, par le biais du test "If target.column = 5", le code
- vérifie que le compte choisi est bien dans la liste (contrôle fait par
VBA puisque dans le cas de zone de validation à saisie semi automatique, il
faut décocher l'option "quand les données....." de l'onglet Alerte Message de
la fenêtre de validation, et donc il n'existe plus de contrôle de validité)
- et copie sur la ligne de la cellule active (target) toutes les formules
et autres listes déroulantes qui se trouvent sur la ligne 1 de l'onglet qui
sert de "ligne modèle"

Sur l'onglet, certaines colonnes sont protégées (P à U et W à X).
La protection de ces plages est effectuée dès que l'utilisateur sélectionne
la feuille, donc dans la procédure évènementielle "Private Sub
Worksheet_Activate".

Je déprotège la feuille dans la procédure Worksheet_SelectionChange pour que
la liste déroulante contenant les comptes puisse se créer (bien que la
colonne 5 ne fasse pas partie des plages protégées ; c'est déjà quelque chose
que je ne comprends pas bien ??).

Je déprotège également la feuille dans le corps de la procédure
Worksheet_Change, juste avant que soient recopiées toutes les listes
déroulantes et formules en provenance la ligne modèle (ligne 1).

Tout ce la se déroule normalement.
MAIS, le problème apparait ensuite car l'utilisateur doit aussi utiliser les
autres listes déroulantes qui ont été recopiées depuis la ligne modèle et à
ce moment là, on se rend compte que la saisie semi-automatique ne marche plus
du tout sur ces listes là.

Dans la procédure Worksheet_Change, j'avais introduis les mêmes contrôle de
validité sur ce qui est saisi dans chacune des listes déroulantes à saisie
semi auto (col 2, col8, col9), avec une MsgBox "L'élément xxxx n'existe pas".
Tout cela fonctionnait bien avant que j'introduise la protection des
cellules.
Maintenant, sur ces listes autres que celle de la colonne 5, la saisie semi
automatique ne marche plus, le contrôle de validité non plus.

De PLUS, je constate que lorsque la souris est au-dessus de la cellule, il
y a la "petite main" comme au dessus des boutons affectés à une macro au lieu
d'avoir la "croix" classique.

Voici le code que j'ai utilisé :

Option Explicit

Private Sub Worksheet_Activate()

With ActiveSheet
.Unprotect
.Cells.Locked = False
.Cells.FormulaHidden = False
.Cells.Range("P3:U100,W3:X672").Locked = True
.EnableSelection = xlUnlockedCells
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, UserInterfaceOnly:=True
.ScrollArea = Range("E65536").End(xlUp).Offset(1, 0)
End With

End Sub


Private Sub Worksheet_Change(ByVal target As Range)
Dim rCel As Range
Dim rValCherchee As Range
Dim rPlage As Range


Application.EnableEvents = False
If target.Column = 2 Then
If target <> "" Then
Set rValCherchee = [vecteur_Entit].Find(target.Value,
LookAt:=xlWhole)
If rValCherchee Is Nothing Then
MsgBox "L'entité " & Range("B" & target.Row).Value & "
n'existe pas"
Application.Undo
End If
End If
ElseIf target.Column = 5 Then
If target <> "" Then
Set rValCherchee = [vecteur_Compte].Find(target.Value,
LookAt:=xlWhole)
If rValCherchee Is Nothing Then
MsgBox "Le compte " & Range("E" & target.Row).Value & "
n'existe pas"
' Application.EnableEvents = False
Application.Undo
' Application.EnableEvents = True
Else
'Copie les formules et les listes déroulantes (dont on
efface le contenu
'sélectionné sur la ligne modèle)
Application.EnableEvents = False
ActiveSheet.Unprotect
Range("A1").Copy
Range("A" & target.Row).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("B1").Copy
Range("B" & target.Row).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("B" & target.Row).ClearContents
Range("F1:J1").Copy
Range("F" & target.Row).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("G" & target.Row & ":J" & target.Row).ClearContents
Range("M1").Copy
Range("M" & target.Row).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("M" & target.Row).ClearContents
Range("P1:U1").Copy
Range("P" & target.Row).Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Refait les bordures des cellules sans formules
Set rPlage = Range("C" & target.Row & ":E" & target.Row)
With rPlage.Borders
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Item(xlEdgeLeft).Weight = xlThin
.Item(xlEdgeTop).Weight = xlThin
.Item(xlEdgeBottom).Weight = xlThin
.Item(xlEdgeRight).Weight = xlThin
.Item(xlInsideVertical).Weight = xlThin
End With
Set rPlage = Range("K" & target.Row & ":L" & target.Row)
With rPlage.Borders
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Item(xlEdgeLeft).Weight = xlThin
.Item(xlEdgeTop).Weight = xlThin
.Item(xlEdgeBottom).Weight = xlThin
.Item(xlEdgeRight).Weight = xlThin
.Item(xlInsideVertical).Weight = xlThin
End With
Set rPlage = Range("N" & target.Row & ":O" & target.Row)
With rPlage.Borders
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.Item(xlEdgeLeft).Weight = xlThin
.Item(xlEdgeTop).Weight = xlThin
.Item(xlEdgeBottom).Weight = xlThin
.Item(xlEdgeRight).Weight = xlThin
.Item(xlInsideVertical).Weight = xlThin
End With
Set rPlage = Range("P" & target.Row & ":U" & target.Row)
rPlage.Locked = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True _
, AllowFormattingCells:=True,
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, UserInterfaceOnly:=True
' Calculate
End If
End If
ElseIf target.Column = 8 Then
If target <> "" Then
Set rValCherchee = [vecteur_Entit].Find(target.Value,
LookAt:=xlWhole)
If rValCherchee Is Nothing Then
MsgBox "L'entité " & Range("H" & target.Row).Value & "
n'existe pas"
Application.Undo
End If
End If
ElseIf target.Column = 9 Then
If target <> "" Then
Set rValCherchee = [vecteur_Entit].Find(target.Value,
LookAt:=xlWhole)
If rValCherchee Is Nothing Then
MsgBox "L'entité " & Range("I" & target.Row).Value & "
n'existe pas"
End If
End If
End If
Application.EnableEvents = True
End Sub


Private Sub Worksheet_SelectionChange(ByVal target As Range)

If target.Column = 5 And target.Row <> 2 And target.Count = 1 Then
ActiveSheet.Unprotect
Range("E" & target.Row).Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=RechercheCpte2"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = False
End With
End If

End Sub

Peut-être que quelqu'un parmi vous aura une idée sur la question.
Je vous remercie par avance de l'aide que vous pourriez m'apporter.
Publicité
Poster une réponse
Anonyme