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.
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.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Daniel.C
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.
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.
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.
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.
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.
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.