Incrémenter ou décrémenter Cellules avec boutton macro

Hello la Team,

Mes connaissances étant assez limitées sur Exel, je fais appel à votre savoir et astuces.

Je vous plante le décors avant tout.

C'est pour le suivit de cadres de clichage sérigraphique. 3 Formats existants avec pour chaque formats 7 maillages différents.

Le fichier Exel va servir à connaitre en instantané la quantité de cadres disponibles à différentes étapes, à savoir Pré encollés, Encollé Neufs et Encollés récup Puis sortie du site car retour fournisseur.

Le fichier sera maintenu à jour manuellement à chaque déplacement du cadre dans son processus de vie. Je cherches un moyen de rentre le fichier plus attractif que de la vulgaire saisie manuelle. Un bouton pour déplacer tel type de cadre dans une étape suivante.

Je vous joint le fichier de base

Merci d'avance

Je pensais à rajouter une colonne Pré encollé Neuf et l'existante en Pré-encollé Récup. Puis faire un double clic sur la ligne pour le passer en Encollé. Un double clic sur Encollé (Neuf ou Recup) avec cette fois ci la question Retour Fournisseur ou repassé en Pré encollé. Si il était neuf il va logiquement passer en Récup.

Je en sais pas si vous comprenez.

Bonjour,

Ça n'inspire personne ? ou alors vous ne comprenez pas ce que je veux ?

Personne ne veux aider ? ou alors je suis pas clair du tout ?

Pour le moment je fais comme ça

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 ActiveCell.Value = ActiveCell.Value + 1
 End Sub

  Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 ActiveCell.Value = ActiveCell.Value - 1
 End Sub

Mais le clic droit est chiant car il ouvre la boite de Dialogue du clic Droit

Il il y a la possibilité d'y attribuer le clic gauche + une touche.

Et puis seulement sur une sélection de cellules car un clic ailleurs que sur une cellule comportant un nombre, me ressort une erreur

Idem il faut cliquer sur la valeur de la cellule alors que n'importe où dans la cellule serait top

Bonjour toutes et tous

@tester pour le clic droit

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'Déclaration de la variable
Dim Cbar As CommandBar
For Each Cbar In Application.CommandBars
Cbar.Enabled = False
Next
' action
 ActiveCell.Value = ActiveCell.Value - 1
 End Sub

et pour réactivé le menu contextuel

Cbar.Enabled = True

crdlt,

André

Merci andré, je teste ça de suite.

Sinon j'ai réussit avec les 2 boutons, mais j'ai des bugs quand je sélectionne une cellule dans le "Range" et que j'incrémente ou décrémente la cellule de droite y a droit aussi, une idée du problème ?

Parfait tout marche.

J'ai rajouter qu'à la sélection de cellules voulues.

'Déclaration de la variable
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Or Target.Count > 1 Then Exit Sub
  If Target < 1 Then SpinButton1 = 0
End Sub

'Action du boutton

Private Sub SpinButton1_Change()
  Dim Bc As Byte
  If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Then Exit Sub
  Bc = ActiveCell
  ActiveCell = SpinButton1
  ActiveCell.Offset(, 1) = ActiveCell.Offset(, 1) - (Bc < SpinButton1) + (Bc > SpinButton1)

End Sub

'Incrémenter par double Clic
  If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Or Target.Count > 1 Then Exit Sub
  Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 ActiveCell.Value = ActiveCell.Value + 1

 End Sub

 'Décrémenter par clic Gauche + désactiver menu contextuel
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Or Target.Count > 1 Then Exit Sub
Dim Cbar As CommandBar
For Each Cbar In Application.CommandBars
Cbar.Enabled = False
Next
' action
 ActiveCell.Value = ActiveCell.Value - 1
 End Sub

Les autres, je tiens aussi à mon Spin boutton qui marche à 90% vu qu'il joue aussi sur la cellule droite de celle sélectionnée

Je vous ai mis le code aussi plus haut

re,

essai

'Déclaration de la variable
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Or Target.Count > 1 Then Exit Sub
  If Target < 1 Then SpinButton1 = 0
End Sub

'Action du bouton

Private Sub SpinButton1_Change()
  Dim Bc
  If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Then Exit Sub
  Bc = ActiveCell
  ActiveCell = SpinButton1
  ActiveCell.Offset(, 1) = ActiveCell.Offset(, 1) - (Bc < SpinButton1) + (Bc > SpinButton1)
  If ActiveCell < 1 Then SpinButton1 = 0
End Sub

' ici -------------------------------------------
  Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     ActiveCell.Value = ActiveCell.Value + 1
    'Incrémenter par double Clic
     If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Or Target.Count > 1 Then Exit Sub
 ' ---------------------------------------------------
 End Sub

 'Décrémenter par clic Gauche + désactiver menu contextuel
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Or Target.Count > 1 Then Exit Sub
Dim Cbar As CommandBar
For Each Cbar In Application.CommandBars
Cbar.Enabled = False
Next
' action
 ActiveCell.Value = ActiveCell.Value - 1
 End Sub

• tu as oublier le code du double clic
• penser à réactiver

Cbar.Enabled = False

Fonctionnel ainsi

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Or Target.Count > 1 Then Exit Sub
  If Target < 1 Then SpinButton1 = 0
End Sub
' ---------
Private Sub SpinButton1_Change()
  Dim Bc
  If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Then Exit Sub
  Bc = ActiveCell
  ActiveCell = SpinButton1
  ActiveCell.Offset = ActiveCell.Offset - (Bc < SpinButton1) + (Bc > SpinButton1)
  If ActiveCell < 1 Then SpinButton1 = 0
End Sub

En fait non je viens de tester

Re,

ok merci

passe une bonne fin de soirée

crdlt,

André

J'en suis à ce code là

'Déclaration de la variable
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Or Target.Count > 1 Then Exit Sub
  If Target < 1 Then SpinButton1 = 0
End Sub

'Action du bouton

Private Sub SpinButton1_Change()
  Dim Bc
  If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Then Exit Sub
  Bc = ActiveCell
  ActiveCell = SpinButton1
  ActiveCell.Offset(, 1) = ActiveCell.Offset(, 1) - (Bc < SpinButton1) + (Bc > SpinButton1)
  If ActiveCell < 1 Then SpinButton1 = 0
End Sub

  Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     ActiveCell.Value = ActiveCell.Value + 1
    'Incrémenter par double Clic
     If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Or Target.Count > 1 Then Exit Sub

 End Sub

 'Décrémenter par clic Gauche + désactiver menu contextuel
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Or Target.Count > 1 Then Exit Sub
Dim Cbar As CommandBar
For Each Cbar In Application.CommandBars
Cbar.Enabled = False
Next
' action
 ActiveCell.Value = ActiveCell.Value - 1
 End Sub

Tout marche à part la cellule de droite de celle sélectionnée qui se retrouve aussi modifiée quand j'utilise les spin boutton

Trouvé

'Déclaration de la variable
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Or Target.Count > 1 Then Exit Sub
  If Target < 1 Then SpinButton1 = 0
End Sub

'Action du boutton

Private Sub SpinButton1_Change()
  Dim Bc As Byte
  If Intersect(ActiveCell, Range("C8:F14,C18:F24,I8:L14")) Is Nothing Then Exit Sub
   Bc = ActiveCell
  ActiveCell = SpinButton1
  ActiveCell.Offset(, 1) = ActiveCell.Offset(, 1)

End Sub

Sympas de pomper ailleurs alors que le besoin est pas le même. J'ai finit par comprendre

Merci André pour ta grande aide. je sens qu'on va se revoir car j'ai encore un autre fichier Exel à réaliser lors de mon stage.

Cette fois c'est un fichier sur le retour des encres, avec du RechercheV ou H mais là je gère mieux que je VBa

Re,

Merci, pas de soucis

Gros changements.

1 Le SpinBoutton ne marche pas comme il faut.

Je veux que quand je sélectionne une cellule, il connaisse sa valeur et que le boutton gauche décrémente la valeure de la cellule et celui de droite incrémente.

2 autres boutons ont vu le jour avec le même besoin

SpinGrand qui doit gérer le range ("C8:E16")

SpinMoyen lui le range ("C20:E28")

Et je voudrais rajouter une option imprimer la feuille print! une selection de cellules de cette feuille, ou la feuille complète mais à l'échelle 100% sur une page A4

Merci d'avance

Pour imprimer j'ai trouver grâce au site

Sub Imprimer()

'

' Imprimer Macro

'

'

Sheets("Print").Select

Application.ScreenUpdating = False

'Définition de la zone à imprimer

Sheets("Print").Select

ActiveSheet.PageSetup.PrintArea = "$B$2:$K$38"

'Impression

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _

IgnorePrintAreas:=False

'désactiver la zone d'impression

ActiveSheet.PageSetup.PrintArea = ""

Application.ScreenUpdating = False

End Sub

Reste mon problème de bouton pour incrémenter

Du coup je suis partit sur de la commande toute simple avec un bouton de contrôle de formule Un bouton - et un bouton +

Pour le boutton -

' Bouton -
' Décrémenter cellule selectionnée
Sub Moins()
ActiveCell.Value = ActiveCell.Value - 1

End Sub

Pour le plus

' Bouton +
' Incrémenter cellule selectionnée
Sub Plus()
ActiveCell.Value = ActiveCell.Value + 1
 End Sub

C'est tout simple. Mais du coup ça marche pour n'importe qu'elle cellule sélectionnée, y compris celles en dehors des tableaux

Comment n'appliquer ces 2 boutons qu'à une plage de cellules ??

Range("C8:F16,I8:L16,C20:F28")

Bonjour toutes et tous

@Kuma007lau

un autre procéder sans boutons de commande

par double clic gauche pour +1 et par clic droit pour -1 dans les cellules concernées (des plages données ("C8:F16,I8:L16,C20:F28")

)

les 2 codes sont placés dans la feuille (Worksheet de l'onglet 'Inventaire') qui,feront appel chacune à l'une des 2 macros du Module 3 (+1 et -1)ainsi, les 6 boutons de commandes de ta feuille Inventaire sont inutiles.

ci-joint,

crdlt

André