Incrementer ou decrementer des cellules en cliquant

tdenfert

XLDnaute Impliqué
Bonjour,

Comme je ne suis pas vraiment à l'aise en VBA si quelqu'un avait la gentillesse de me donner une piste ....
J'ai mis les explications dans le fichier.

Merci à tous ceux qui voudrons bien m'aider

Bonnes fêtes
 

Pièces jointes

  • conso.xls
    19.5 KB · Affichages: 184
  • conso.xls
    19.5 KB · Affichages: 190
  • conso.xls
    19.5 KB · Affichages: 182

Efgé

XLDnaute Barbatruc
Bonjour Kuma007lau

Si tu parles de ma proposition pleine de boutons...
Pour la modif:
VB:
Private Sub ButtonGroup_Click()
Dim Adr As String
Adr = ButtonGroup.TopLeftCell.Address
With Range(Adr)
    If .Column = 3 Then
        If .Offset(0, 1).Value > 0 Then
            .Offset(0, 1).Value = .Offset(0, 1).Value - 1
            '.Offset(0, 3).Value = .Offset(0, 3).Value - 1
        End If
    ElseIf .Column = 5 Then
            .Offset(0, -1).Value = .Offset(0, -1).Value + 1
            '.Offset(0, 1).Value = .Offset(0, 1).Value + 1
    End If
End With
End Sub

Si c'est la version de Fo_rum absent depuis 2012:
Deux modifs:

VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Intersect(ActiveCell, Range("Dujour")) Is Nothing Or Target.CountLarge > 1 Then Exit Sub
  If Target < 1 Then SpinButton1 = 0
End Sub
Private Sub SpinButton1_Change()
  Dim Bc As Byte
  If Intersect(ActiveCell, Range("Dujour")) Is Nothing Then Exit Sub
  Bc = ActiveCell
  ActiveCell = SpinButton1
  'ActiveCell.Offset(, 1) = ActiveCell.Offset(, 1) - (Bc < SpinButton1) + (Bc > SpinButton1)
End Sub

Cordialement
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 328
Messages
2 087 316
Membres
103 515
dernier inscrit
Cherbil12345