Erreur lors de selection multiples

Bonjour à tous,

je vous explique mon problème.

J'ai un fichier où, dans les colonnes R, S, T et U, apparait une ListBox quand clique sur une cellule de ces colonnes pour que l'on puisse faire un choix parmi les critères proposés.

Tout fonctionne parfaitement, ce qui tiens déjà du miracle vu que c'est moi qui ai codé.

Cependant une petite erreur persiste. Si l'utilisateur du fichier fait une sélection multiple de cellule, avec pour origine une cellule des colonnes ci dessous ("R2:T9" par exemple), une fenêtre "erreur d'exécution '13' " apparait.

J'aimerais savoir si il est possible d'empêcher l'apparition de cette fenêtre, soit en modifiant ma macro (je n'ai pas trouvé comment faire), soit en empêchant l'apparition de fenêtre d'erreur (Application.DisplayAlerts = False ne marche pas ou je n'ai pas bien compris comment le faire fonctionner)

Merci par avance pour votre aide et vos retours

Le fichier en question

Salut,

En rajoutant un if qui vérifie combien de cellules sont sélectionnées avant de lancer ton code ça donne ceci :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Selection.Cells.Count = 1 Then

    LastLig = Cells(Rows.Count, 1).End(xlUp).Row

  If Not Intersect(Range("R2:S" & LastLig), Target) Is Nothing Then
    Me.ListBox1.MultiSelect = fmMultiSelectMulti
    Me.ListBox1.List = Sheets("Liste").Range("Tableau1").Value
    a = Split(Target, " ")
    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 Me.ListBox1.Selected(i) = True
      Next i
    End If
    Me.ListBox1.Height = 210
    Me.ListBox1.Width = 150
    Me.ListBox1.Top = Target.Top
    Me.ListBox1.Left = Target.Left + Target.Width
    Me.ListBox1.Visible = True
  Else
      Me.ListBox1.Visible = False
  End If

  If Not Intersect(Range("T2:T" & LastLig), Target) Is Nothing Then
    Me.ListBox2.MultiSelect = fmMultiSelectMulti
    Me.ListBox2.List = Sheets("Liste").Range("Tableau2").Value
    a = Split(Target, " ")
    If UBound(a) >= 0 Then
      For i = 0 To Me.ListBox2.ListCount - 1
        If Not IsError(Application.Match(Me.ListBox2.List(i), a, 0)) Then Me.ListBox2.Selected(i) = True
      Next i
    End If
    Me.ListBox2.Height = 90
    Me.ListBox2.Width = 160
    Me.ListBox2.Top = Target.Top
    Me.ListBox2.Left = Target.Left + Target.Width
    Me.ListBox2.Visible = True
  Else
      Me.ListBox2.Visible = False
  End If

  If Not Intersect(Range("U2:U" & LastLig), Target) Is Nothing Then
    Me.ListBox3.MultiSelect = fmMultiSelectMulti
    Me.ListBox3.List = Sheets("Liste").Range("Tableau3").Value
    a = Split(Target, " ")
    If UBound(a) >= 0 Then
      For i = 0 To Me.ListBox3.ListCount - 1
        If Not IsError(Application.Match(Me.ListBox3.List(i), a, 0)) Then Me.ListBox3.Selected(i) = True
      Next i
    End If
    Me.ListBox3.Height = 60
    Me.ListBox3.Width = 100
    Me.ListBox3.Top = Target.Top
    Me.ListBox3.Left = Target.Left + Target.Width
    Me.ListBox3.Visible = True
  Else
      Me.ListBox3.Visible = False
  End If

End If

End Sub

J'ai rajouté :

Au début :

If Selection.Cells.Count = 1 Then

A la fin

End If

Girodo,

Bonjour,

Une solution toute simple serait d'écrire ça en début de programme:

If Target.Cells.Count > 1 Then Exit Sub

En cas de sélection multiple, tu quittes le programme

Bonjour à tous les 2,

Déjà un grand merci pour vos 2 réponses qui fonctionnent parfaitement.

C'est quand même assez évident au final comme solution...

Un grand merci ^.^ sujet clos

Re,

Une fois trouvée ça semble évident, mais ce n'est pas toujours évident à trouver