BeforeDoubleClick plusieurs cellules

Bonjour

J'essaie de mettre dans une la procédure " Beforedouble click " trois cellule cible qui appelleront trois series de macros distinct.

J'ai adapter comme suit, mais cela fonctionne correctement pour les cellules W32 et W30, mais pas pour la troisième W28.

Auriez vous une idée pour que les trois fonctionnent .

merci

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim but As Range
Set but = Range("W32")
If Not Intersect(Target, but) Is Nothing Then 

Application.EditDirectlyInCell = False
Select Case Target.Interior.ColorIndex
Case Is = xlNone 'rien
Target.Interior.ColorIndex = 2
Call Serp_1
Case Is = 2
Target.Interior.ColorIndex = 34
Call Serp_2
Case Is = 34
Target.Interior.ColorIndex = 35
Call Serp_3
Case Is = 35
Target.Interior.ColorIndex = 19
Case Else
Target.Interior.ColorIndex = xlNone
Call Serp_4
End Select

Else

Set but = Range("W30")
If Not Intersect(Target, but) Is Nothing Then 

' la serie2 de macro
Else

Set but = Range("W28")
If Not Intersect(Target, but) Is Nothing Then Exit Sub

'-la serie3 de macro

End If
End If
End Sub

Bonjour Maroli et

Une petite présentation ICI serait la bienvenue

Si vous ne l'avez pas encore fait, je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum.

Pour votre demande, voici une possibilité

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  ' Vérifier si la cellule est la bonne, sinon on sort
  If Intersect(Target, Range("W28,W30,W32")) Is Nothing Then Exit Sub
  ' Si ok
  Cancel = True
  '
  If Target.Address = "$W$32" Then
    Select Case Target.Interior.ColorIndex
    Case Is = xlNone 'rien
    Target.Interior.ColorIndex = 2
    'Call Serp_1
    Case Is = 2
    Target.Interior.ColorIndex = 34
    'Call Serp_2
    Case Is = 34
    Target.Interior.ColorIndex = 35
    'Call Serp_3
    Case Is = 35
    Target.Interior.ColorIndex = 19
    Case Else
    Target.Interior.ColorIndex = xlNone
    'Call Serp_4
    End Select
  End If
  ' la serie2 de macro
  If Target.Address = "$W$30" Then

  End If
  '-la serie3 de macro
  If Target.Address = "$W$28" Then

  End If
End Sub

Bonne participation

A+

Bonjour

Je m'attacherai a faire la presentation.

J'ai essayé le code transmi mais cela ne fonctionne pas au double click sur les cellules concernées

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  ' Vérifier si la cellule est la bonne, sinon on sort
  If Intersect(Target, Range("W28,W30,W32")) Is Nothing Then Exit Sub
  ' Si ok
  Cancel = True
  If Target.Address = "$W$32" Then
   MsgBox ("VEUILLEZ REFERENCER AFFAIRE-CLIENT")
  End If
  If Target.Address = "$W$30" Then
MsgBox ("VEUILLEZ REFERENCER ")
  End If
  If Target.Address = "$W$28" Then
MsgBox ("AFFAIRE-CLIENT")
  End If
End Sub

Bonjour,

Navré de vous décevoir mais quand je donne du code, en général je le teste

Le votre mis dans la feuille fonctionne également

A+

Bonjour BrunoM45

Effectivement le problème venait des séries de macro et même le code de départ fonctionne correctement.