XL 2010 case a cocher - modification de macro

[jokerfidelio]

Bonjour à tous,

J’aimerais si possible modifier cette macro, qui d'ailleurs fonctionne êtres bien, mais je voudrais
modifier celle ci pour que quand je clic sur la cellule exemple en "F9" en parallele sur cette même ligne
AUTOMATIQUEMENT si "G9" est coché celle ci ce décoche automatiquement.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  temp = Array("X", "")
  If Not Application.Intersect(Target, Range("F9:F17, G9:G17")) 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

merci a vous tous, pour toute l'aide que vous apportez !

 

[mécano41]

Bonjour,

Comme ceci peut-être...

Private Sub Worksheet_BeforeDoubleClick(ByVal Coche As Range, Retour As Boolean)
If Not Application.Intersect(Coche, Range("F9:F17, G9:G17")) Is Nothing Then
  If Coche.Value = "X" Then
  Coche.Value = ""
  Else
  Coche.Value = "X"
  Coche.Offset(0, 1).Value = ""
  End If
End If
End Sub

Cordialement

 

[jokerfidelio]

Bonjour,

Comme ceci peut-être...

Private Sub Worksheet_BeforeDoubleClick(ByVal Coche As Range, Retour As Boolean)
If Not Application.Intersect(Coche, Range("F9:F17, G9:G17")) Is Nothing Then
  If Coche.Value = "X" Then
  Coche.Value = ""
  Else
  Coche.Value = "X"
  Coche.Offset(0, 1).Value = ""
  End If
End If
End Sub

Cordialement

non cela ne fonctionne pas !

 

[mécano41]

Qu'est-ce qui ne fonctionne pas?

Cordialement

 

[jokerfidelio]

Tout dépend ou l on se trouve sur le feuille, le décochement n'est pas automatique sur la mémé ligne a chaque fois

 

[jokerfidelio]

de droite a gauche ok mais pas dans les deux sens

 

[giti]

bonjour quelqu'un peut répondre à ma question je pense ça doit être hyper facile pour quelqu'un qui se connaît en VBA c'est la discussion incrémenter une ligne merci

 

[Si...]

Bon_jour

avec réciprocité

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
  If Not Application.Intersect(R, [F9:G17]) Is Nothing Then
    R = IIf(R = "", "X", "")
    If R.Column = 6 Then R(1, 2) = IIf(R = "", "X", "")
    If R.Column = 7 Then R(1, 0) = IIf(R = "", "X", "")
    [E9].Select
  End If
End Sub

 

[jokerfidelio]

Bon_jour

avec réciprocité

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
  If Not Application.Intersect(R, [F9:G17]) Is Nothing Then
    R = IIf(R = "", "X", "")
    If R.Column = 6 Then R(1, 2) = IIf(R = "", "X", "")
    If R.Column = 7 Then R(1, 0) = IIf(R = "", "X", "")
    [E9].Select
  End If
End Sub

Super, fonctionnel a 100% merci a vous tous