Double clic pour cocher sur cellule fusionnée

Résolu
nathan01983 Messages postés 30 Date d'inscription   Statut Membre Dernière intervention   -  
pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   -
Bonjour je n'arrive pas à trouver de solution à mon problème

j'ai un code pour cocher une cellule en double cliquant dessus mais je n'arrive pas à la faire fonctionner sur une cellule fusionnée.

Pourriez vous m'aider svp.

Merci

Voilà le code

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  temp = Array("X", "")
  If Not Application.Intersect(Target, Range("F7:H300")) Is Nothing Then
    With Target
  p = Application.Match(Target, temp, 0)
  If Not IsError(p) Then
    If p = UBound(temp) + 1 Then p = 0
  Else
    p = 0
  End If
  Target = temp(p)
  Cancel = True
  End With
  End If
End Sub

2 réponses

  1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bonjour,

    Tout simplement en utilisant la première cellule du Range Target : Target.Cells(1) :
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim temp, p
       temp = Array("X", "")
       If Not Application.Intersect(Target, Range("F7:H300")) Is Nothing Then
          With Target.Cells(1)
             p = Application.Match(.Value, temp, 0)
             If Not IsError(p) Then
                If p = UBound(temp) + 1 Then p = 0
             Else
                p = 0
             End If
             .Value = temp(p)
             Cancel = True
          End With
       End If
    End Sub

    0
    1. nathan01983 Messages postés 30 Date d'inscription   Statut Membre Dernière intervention   10
       
      là je n'ai qu'une chose à dire MERCI BEAUCOUP !!!!!!!!!
      0
    2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Une deuxième chose à dire serait de remercier Mike31 (salutations au passage).
      A++
      0
  2. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Bonjour,

    ajoute simplement une gestion d'erreur cela devrait le faire et qui te servira en cas d'autres erreurs possibles et évitera le blocage de ton code

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
      temp = Array("X", "")
      If Not Application.Intersect(Target, Range("F7:H300")) Is Nothing Then
      On Error Resume Next
        With Target
      p = Application.Match(Target, temp, 0)
      If Not IsError(p) Then
        If p = UBound(temp) + 1 Then p = 0
      Else
        p = 0
      End If
      Target = temp(p)
      Cancel = True
      End With
      End If
    End Sub 


    0