Liste déroulante à choix multiple déplacée quand la feuille est verrouillée

Fermé
kleoff Messages postés 1 Date d'inscription vendredi 13 mars 2020 Statut Membre Dernière intervention 13 mars 2020 - 13 mars 2020 à 09:45
Bonjour,

Je travaille sur un questionnaire de satisfaction client fait sur Excel. J'ai mis des listes déroulantes à choix multiples grâce à VBA, et j'ai défini leur position pour qu'elles apparaissent à côté de la cellule active pour pouvoir faire les choix.

En verrouillant la cellule, les listes se déplace d'une dizaine de lignes au dessus je comprends pas j'ai pourtant vérifié le code, peut-être que je loupe quelque chose...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column = 9 Then
If Cells(ActiveCell.Row, 8) = "" Then
Me.ListBox1.Visible = False
Exit Sub
End If
With Me.ListBox1
.MultiSelect = fmMultiSelectMulti
.ListStyle = fmListStyleOption
.Height = 150
.Width = 300
.Top = ActiveCell.Top
.Left = ActiveCell.Offset(0, 1).Left
.Visible = True
End With
On Error Resume Next
i = Application.WorksheetFunction.Match(Cells(ActiveCell.Row, 8), Worksheets("brainstorming").Range("critères"), 0) - 1
Me.ListBox1.List = Worksheets("brainstorming").Range(Worksheets("brainstorming").Range("A1").Offset(3, i), _
Worksheets("brainstorming").Range("A1").Offset(0, i).End(xlDown)).Value
On Error GoTo 0
a = VBA.Split(ActiveCell, "-")
If UBound(a) >= 0 Then
For i = 0 To Me.ListBox1.ListCount - 1
If Not IsError(Application.Match(Me.ListBox1.List(i), a, 0)) Then
btest = True
Me.ListBox1.Selected(i) = True
btest = False
End If
Next
End If

Else
Me.ListBox1.Visible = False

If ActiveCell.Column = 4 Then
Calculate

If Not Intersect(Target, Range("D39:D44")) Is Nothing Then GoTo AA:
If Not Intersect(Target, Range("D47:D52")) Is Nothing Then GoTo AA:
If Not Intersect(Target, Range("D55:D60")) Is Nothing Then GoTo AA:
If Not Intersect(Target, Range("D63:D68")) Is Nothing Then GoTo AA

If Not Intersect(Target, Range("D80:D83")) Is Nothing Then GoTo AA:
If Not Intersect(Target, Range("D88:D91")) Is Nothing Then GoTo AA:
If Not Intersect(Target, Range("D96:D99")) Is Nothing Then GoTo AA:
If Not Intersect(Target, Range("D104:D107")) Is Nothing Then GoTo AA

If Not Intersect(Target, Range("D120:D123")) Is Nothing Then GoTo AA:
If Not Intersect(Target, Range("D128:D131")) Is Nothing Then GoTo AA:
If Not Intersect(Target, Range("D136:D139")) Is Nothing Then GoTo AA:
If Not Intersect(Target, Range("D144:D147")) Is Nothing Then GoTo AA

If Not Intersect(Target, Range("D159:D162")) Is Nothing Then GoTo AA:
If Not Intersect(Target, Range("D167:D170")) Is Nothing Then GoTo AA:
If Not Intersect(Target, Range("D175:D178")) Is Nothing Then GoTo AA:
If Not Intersect(Target, Range("D183:D186")) Is Nothing Then GoTo AA Else Exit Sub

AA:
Set cell = Target
colorcase


End If
End If
End Sub