Problème suite à la protection des feuilles de calcul Excel

Le
COQUITO
Bonjour à tous,

J'envoie une 2ème fois mon message, ne sachant pas si le premier est
réellement parvenu sur le site car je ne m'étais peut-être pas correctement
inscrite, étant tout à fait novice en matière de forum de discussion.
Voici ce que j'avais écrit précédemment :

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
michdenis
Le #21533551
Bonjour,

Il n'est pas évident à la lecture de saisir ce que tu fais comme
manoeuvre dans ton application...Comme tu dis que tes
difficultés sont apparues lorsque tu as voulu protéger ta feuille,
tu peux résoudre une partie de ton problème en
permettant aux automatisations de fonctionner lorsqu'elles sont
réalisées en VBA. Pour ce faire, utilise l'événement Workbook_Open
dans le ThisWorkbook. Dans le reste de ton code, tu n'as pas
à te préoccuper du facteur "protect" de la feuille pour y effectuer
des modifications par macro.
J'ai passé le paramètre DrawingObjects:úlse lorsque tu protèges
ta feuille pour permettre tes listes déroulantes de fonctionner.

Dans la procédure suivante, modifie "Sheet1" par la propriété "NAME"
de l'objet "Feuille" visible dans la fenêtre de l'éditeur de code où
l'action se déroule.
'----------------------------------------
Private Sub Workbook_Open()
With Sheet1
.Unprotect
.Cells.Locked = False
.Cells.FormulaHidden = False
.Range("P3:U100,W3:X672").Locked = True
.EnableSelection = xlUnlockedCells
.Protect DrawingObjects:úlse, Contents:=True, UserInterfaceOnly:=True
.ScrollArea = .Range("E65536").End(xlUp).Offset(1, 0)
End With
End Sub
'----------------------------------------
Publicité
Poster une réponse
Anonyme