augmenter valeurs de cellules grâce à un bouton

andersfriden

XLDnaute Nouveau
bonjour, ou même bonsoir !

je vous écris pour avoir un petit peu d'aide à propos d'une fonctionnalité que je voudrais mettre dans une feuille. Je vais tenter d'être le plus explicite possible ! Dans une cellule, j'ai un nombre. Il ne peut pas être plus petit que 150. J'ai inséré un bouton "toupie" depuis l'onglet développeur (version 2007) pour augmenter ce nombre de 50 en 50 (format du bouton, puis changement de pas), puis de 100 en 100, et de 250 en 250, suivant la tranche atteinte. Là où ça se corse, c'est que j'ai plusieurs cellules (16 pour être précis) qui ont le même fonctionnement, et que je ne souhaite pas créer 16 boutons, surtout que j'ai une dizaine de feuilles semblables (je vous laisse faire le calcul...). Ce que j'aimerais, c'est que quand je sélectionne une cellule, cliquer sur le bouton modifie cette cellule. Et sélectionner une autre cellule, permet de modifier cette cellule, toujours avec le même bouton. C'est pour éviter la multiplication de boutons, et la surcharge d'objets sur la feuille. J'ai posté sur un autre forum, et on m'a donné ça :


Code:
Private Sub SpinButton1_Change()

    With SpinButton1
    
        'défini le pas en fonction de la valeur de la cellule
       If ActiveCell >= 1000 Then .SmallChange = 100

        If ActiveCell >= 10000 Then .SmallChange = 250
        
        If ActiveCell < 1000 Then .SmallChange = 50
        
    End With
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    With SpinButton1
            
        'si pas de valeur dans la cellule, pas de cellule liée et fin
       If Target.Value = "" Then
        
            .LinkedCell = ""
            Exit Sub
            
        End If
        If Not IsNumeric(Target.Value) Then
        
            .LinkedCell = ""
            Exit Sub
        
        End If
        
        'défini la cellule devant recevoir la valeur
       .LinkedCell = Target.Address(0, 0)
        
        If Target.Value < .Min Then .Value = .Min Else .Value = Target.Value
    
    End With

End Sub

[/QUOTE]
 
Sauf que ça ne marche pas, la cellule active n'est pus sélectionnée quand je clique sur le bouton "toupie".

Voilà, j'attends vos réponses. Merci d'avance !
 

Dranreb

XLDnaute Barbatruc
Re : augmenter valeurs de cellules grâce à un bouton

Bonjour.
Le fait que la cellule ne soit plus sélectionnée quand on clique sur le bouton toupie ne devrait pas gêner son fonctionnement puisque ce n'est pas à ce moment là que la cellule liée (propriété LinkedCell) est définie.
Si le problème est juste que ce soit gênant par ailleurs qu'elle ne reste pas sélectrionnée, il devrait être possible de sélectionner la cellule notée dans cette propriété à la fin de la SpinButton1_Change
À +
 

kjin

XLDnaute Barbatruc
Re : augmenter valeurs de cellules grâce à un bouton

Bonsoir,
Au plus simple et si j'ai bien compris
Code:
Private Sub SpinButton1_SpinDown()
Set r = Range("C3,C14,C20,D8,E12,E21,G7")
If Not Intersect(r, ActiveCell) Is Nothing Then
    Select Case ActiveCell
    Case Is < 1000
    ActiveCell = ActiveCell - 50
    Case Is < 10000
    ActiveCell = ActiveCell - 100
    Case Else
    ActiveCell = ActiveCell - 250
    End Select
    If ActiveCell <= 150 Then ActiveCell = 150
    ActiveSheet.Select
End If
End Sub

Private Sub SpinButton1_SpinUp()
Set r = Range("C3,C14,C20,D8,E12,E21,G7")
If Not Intersect(r, ActiveCell) Is Nothing Then
    Select Case ActiveCell
    Case Is < 1000
    ActiveCell = ActiveCell + 50
    Case Is < 10000
    ActiveCell = ActiveCell + 100
    Case Else
    ActiveCell = ActiveCell + 250
    End Select
    ActiveSheet.Select
End If
End Sub
A+
kjin
 

Pièces jointes

  • anders.xls
    24.5 KB · Affichages: 43
  • anders.xls
    24.5 KB · Affichages: 57
  • anders.xls
    24.5 KB · Affichages: 42

andersfriden

XLDnaute Nouveau
Re : augmenter valeurs de cellules grâce à un bouton

Bonsoir,
Au plus simple et si j'ai bien compris
Code:
Private Sub SpinButton1_SpinDown()
Set r = Range("C3,C14,C20,D8,E12,E21,G7")
If Not Intersect(r, ActiveCell) Is Nothing Then
    Select Case ActiveCell
    Case Is < 1000
    ActiveCell = ActiveCell - 50
    Case Is < 10000
    ActiveCell = ActiveCell - 100
    Case Else
    ActiveCell = ActiveCell - 250
    End Select
    If ActiveCell <= 150 Then ActiveCell = 150
    ActiveSheet.Select
End If
End Sub

Private Sub SpinButton1_SpinUp()
Set r = Range("C3,C14,C20,D8,E12,E21,G7")
If Not Intersect(r, ActiveCell) Is Nothing Then
    Select Case ActiveCell
    Case Is < 1000
    ActiveCell = ActiveCell + 50
    Case Is < 10000
    ActiveCell = ActiveCell + 100
    Case Else
    ActiveCell = ActiveCell + 250
    End Select
    ActiveSheet.Select
End If
End Sub
A+
kjin

merci beaucoup ! c'est exactement ce que je voulais ! juste une petite chose : est-ce nécessaire de spécifier les cellules concernées dans le code ? si je souhaite ajouter une cellule, je dois le modifier dans le code ? J'ai plusieurs feuilles calquées sur le même modèle : dois-je créer autant de feuilles de code et de boutons que de feuilles de calcul ?
 

Discussions similaires

Statistiques des forums

Discussions
312 322
Messages
2 087 275
Membres
103 504
dernier inscrit
Marie28