XL 2019 Double clic gauche doit ajouter +1 au chiffre à droite de la cellule en G [XL 2019]

[anthoYS]

Bonjour,

Sachant qu'un clic droit ajoute un commentaire déjà.
voir ci-joint...


Merci

 

[sylvanu]

Bonjour Antho,
En PJ un essai.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
    If .Column = 7 Then
        Cancel = True
        Cells(.Row, .Column + 1) = 1 + Cells(.Row, .Column + 1)
    End If
End With
End Sub

 

[anthoYS]

Bonjour Antho,
En PJ un essai.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
    If .Column = 7 Then
        Cancel = True
        Cells(.Row, .Column + 1) = 1 + Cells(.Row, .Column + 1)
    End If
End With
End Sub

Non rajouter un au chiffre de droite pas de la cellule d'à côté.
Pour ma part j'ai fusionné avec un code déjà présent ceci explique peut être cela.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  With Target
    If .Column = 7 Then
        Cancel = True
        Cells(.Row, .Column + 1) = 1 + Cells(.Row, .Column + 1)
    End If
End With
  If Not Application.Intersect(Target, Range("B:B")) Is Nothing And IsEmpty(Target) Then
F_calendrier1dateTableur.Show
End If
Cancel = True
If Target.Column = 8 Then
Cells(Target.Row, 8) = Date
Cells(Target.Row, 6).Interior.color = vbYellow '  jaune
End If
If Target.Column = 11 Then
Cells(Target.Row, 11) = Date
Cells(Target.Row, 10).Interior.color = vbGreen ' Vert
End If
End Sub

 

[anthoYS]

En G11, ça doit afficher "E03J10"
En G3 : "R01B05"

après un double clic dans chaque et ainsi de suite...

 

[M12]

Bonjour
Bonjour sylvanu

Si j'ai compris

 

[anthoYS]

Merci beaucoup @M12
@sylvanu merci également
Bonne fin de journée, c'est solutionné.

 

[anthoYS]

Dans les solutions fournies, quand je double clique et que ça passe à 10 ou 20 il y a un mega bug.
Voici un bout du code :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Application.Intersect(Target, Range("G:G")) Is Nothing Then
    If IsNumeric(Mid(Target.Value, Len(Target.Value), 1)) Then
      Target.Value = Mid(Target.Value, 1, Len(Target.Value) - 1) & Mid(Target.Value, Len(Target.Value), 1) + 1
    Else
      Target.Value = Target.Value & 1
    End If
  End If
  If Not Application.Intersect(Target, Range("B:B")) Is Nothing And IsEmpty(Target) Then
F_calendrier1dateTableur.Show
End If

Pour passer de 09 à 10 (010)
et de 19 à 20 (110)
Or je veux 10 et 20 respectivement.

Merci !