XL 2021 Faire une boucle de création boutons

AggeR

XLDnaute Nouveau
Bonjour,
Pour suivre un peu notre stock il faut qu'on sache la quantité de pièces par type
Ducoup, dans un excel J'ai créé 2 boutons ( + et -) pour chaque ligne comme suivant:
1697619800833.png


Sub BoutonI4MOINS()
Range("I4").Select
ActiveCell = ActiveCell - 1
End Sub
Sub BoutonI4PLUS()
Range("I4").Select
ActiveCell = ActiveCell + 1
End Sub

Le problème c'est que j'ai 2000 lignes a faire.
Est ce qu'il y'as une solution pour dupliquer la fonction ??

Merci.
 
Solution
Bonjour AggeR, et bienvenu sur XLD,
Ca va vous faire 4000 boutons, plus les soucis pour le rajout de ligne, et la suppression de lignes.
A mon avis une belle usine à gaz.
Comme je suppose que Bouton signifie utilisation du VBA, je pense qu'il existe une solution plus simple. Voir PJ.
Deux colonnes En plus et En moins, quand on clique sur une ligne on ajoute ou soustrait 1 de la colonne Nombre.
Si on ajoute une ligne les signes "+" et "-" se dupliqueront automatiquement.
Avec dans la feuil1 :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [L:M]) Is Nothing Then
        L = Target.Row
        If Cells(L, "A") = "" Then Exit Sub     ' On...

sousou

XLDnaute Barbatruc
Bonjour,
Tu n'as certainement pas besoin de créer autant de bouton. en tout cas une seule fonction doit suffire, si elle agit sur la ligne active.
exemple:
sub plus()
activesheet.cells(active.cell.row,9)=activesheet.cells(active.cell.row,9)+1
end sub
Mais si tu lis la charte un fichier ne serait pas superflus :(
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour AggeR, et bienvenu sur XLD,
Ca va vous faire 4000 boutons, plus les soucis pour le rajout de ligne, et la suppression de lignes.
A mon avis une belle usine à gaz.
Comme je suppose que Bouton signifie utilisation du VBA, je pense qu'il existe une solution plus simple. Voir PJ.
Deux colonnes En plus et En moins, quand on clique sur une ligne on ajoute ou soustrait 1 de la colonne Nombre.
Si on ajoute une ligne les signes "+" et "-" se dupliqueront automatiquement.
Avec dans la feuil1 :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [L:M]) Is Nothing Then
        L = Target.Row
        If Cells(L, "A") = "" Then Exit Sub     ' On sort si Etagère vide
        If Target.Column = 12 Then              ' Clic "+" on ajoute 1 à Nombre
            Cells(L, "H") = Cells(L, "G")
            Cells(L, "G") = Cells(L, "G") + 1
            Cells(1, 12).Select
        ElseIf Target.Column = 13 Then          ' Clic "-" on soustrait 1 à Nombre
            If Cells(L, "G") = 0 Then Exit Sub  ' Car Qté nulle
            Cells(L, "H") = Cells(L, "G")
            Cells(L, "G") = Cells(L, "G") - 1
            Cells(1, 13).Select
        End If
    End If
Fin:
End Sub
regardez si une telle solution vous convient.
 

Pièces jointes

  • AggeR.xlsm
    16.4 KB · Affichages: 1

AggeR

XLDnaute Nouveau
Bonjour AggeR, et bienvenu sur XLD,
Ca va vous faire 4000 boutons, plus les soucis pour le rajout de ligne, et la suppression de lignes.
A mon avis une belle usine à gaz.
Comme je suppose que Bouton signifie utilisation du VBA, je pense qu'il existe une solution plus simple. Voir PJ.
Deux colonnes En plus et En moins, quand on clique sur une ligne on ajoute ou soustrait 1 de la colonne Nombre.
Si on ajoute une ligne les signes "+" et "-" se dupliqueront automatiquement.
Avec dans la feuil1 :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [L:M]) Is Nothing Then
        L = Target.Row
        If Cells(L, "A") = "" Then Exit Sub     ' On sort si Etagère vide
        If Target.Column = 12 Then              ' Clic "+" on ajoute 1 à Nombre
            Cells(L, "H") = Cells(L, "G")
            Cells(L, "G") = Cells(L, "G") + 1
            Cells(1, 12).Select
        ElseIf Target.Column = 13 Then          ' Clic "-" on soustrait 1 à Nombre
            If Cells(L, "G") = 0 Then Exit Sub  ' Car Qté nulle
            Cells(L, "H") = Cells(L, "G")
            Cells(L, "G") = Cells(L, "G") - 1
            Cells(1, 13).Select
        End If
    End If
Fin:
End Sub
regardez si une telle solution vous convient.
Merci beaucoup,
je vais l'essayer.
 

Discussions similaires

Statistiques des forums

Discussions
312 215
Messages
2 086 329
Membres
103 183
dernier inscrit
karelhu35