incrémenter / décrémenter

[seblap47]

Bonjour,

Le but de ce fichier (fonctionnel) est de comptabiliser en fin de journée le nombre de plateaux (de fraise) que chaque "ramasseur" a fait.
Chaque ramasseur colle un code barre qui lui est propre sur chacun de ses plateaux.
En fin de journée, on scanne l'ensemble des plateaux des ramasseurs.
Sur la feuille "Accueil" dans la colonne C il y a le total des plateaux qui est incrémenté au fur et à mesure que l'on scanne les plateaux.
On scanne les code barre (ou on rentre manuellement la valeur) dans la colonne B4 de la feuille "Accueil".
Je ne vais pas m'étendre sur les boutons "Préparer impression", "Enregistrer en PDF" et "Voir PDF" qui fonctionnent et dont l'explication n'apportera rien à ce post.

Les boutons 1 à 10 sont là uniquement à des fins de tests.
Je n'ai pas de lecteur de code barre sous la main.
Pour éviter de saisir manuellement la valeur du code barre, je clique sur les boutons de 1 à 10 pour incrémenter dans la colonne C les plateaux des ramasseurs de 1 à 10.

Au fur et à mesure que l'on scanne les plateaux, une liste ce forme en feuille "Totaux".

Dans la feuille "Ramasseurs" il y a 3 colonnes.

A : Les ramasseurs de 1 à 50

B : soit on laisse comme ça soit je peux mettre le nom propre de la personne qui ramasse.
C'est ce nom qui se reporte dans la colonne B de la feuille "Accueil"

C : la valeur du code barre

Jusque-là tout marche.

Si jamais je me trompe pendant le scan des codes-barres, je dois pouvoir corriger ça.
Pour ce faire il y a le bouton "Correction" sur la page "Accueil"

Explication :

Je clique sur le bouton "Correction"
Je rentre ou je scanne le code barre dans la zone code barre.
Je clique sur "Modifier"
Je vois la valeur actuelle.

Je voudrais pouvoir incrémenter ou décrémenter la valeur en cours à l'aide des boutons + et -

Merci

Cordialement

 

[seblap47]

Re : incrémenter / décrémenter

Pour info voilà le code corrigé

Option Explicit

Sub Scan()
Dim Cel
Application.ScreenUpdating = False
For Each Cel In Array("B4")
Next Cel
ActiveSheet.Unprotect 'dévérouille la feuille accueil
Range("Saisie").Copy
With Sheets("Totaux")
.Range("A65536").End(xlUp)(2) _
.PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With

Application.CutCopyMode = False
Range("B4:B5").ClearContents
Range("B4").Activate

ActiveSheet.Protect 'verouille la feuille Accueil
End Sub

Sub Impression()

Const NB_LIGNES = 50 'nb de lignes à prendre en compte

Worksheets("Impression").Columns("A:B").ClearContents
Dim No_Ligne2
Dim No_Ligne
No_Ligne2 = 5 'liste à partir de Impression!A5

For No_Ligne = 11 To NB_LIGNES + 2 'début source données Accueil!A11
If Cells(No_Ligne, 3) <> "" And Cells(No_Ligne, 3) <> 0 Then
Worksheets("Impression").Cells(No_Ligne2, 1) = Cells(No_Ligne, 2)
Worksheets("Impression").Cells(No_Ligne2, 2) = Cells(No_Ligne, 3)
No_Ligne2 = No_Ligne2 + 1
End If
Next
Sheets(4).Range("A4") = "Ramasseur" 're-écrit entête
Sheets(4).Range("B4") = "Q" 're-écrit entête
Sheets(4).Range("A2") = Date 're-écrit entête

'Sheets(4).PrintOut 'ActiveSheet.PrintOut imprime la feuille active
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True, Collate:=True
'Application.Dialogs(xlDialogPrint).Show <-- pour choisir l'imprimante

End Sub

Sub Voir_PDF()
'emplacement a derterminée

Sheets(4).Select
Dim nom As String
'nom = Sheets(1.)Range("A2")
nom = "rammassage du "

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nom _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Sheets(4).Select
'Unload Me
End Sub

Sub Enregistrer_PDF()
Sheets(4).ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\ramassage_" & Day(Now) & Month(Now) & Year(Now)
End Sub

 

[camarchepas]

Re : incrémenter / décrémenter

Bonsoir ,

voici pour le plus moins et le rappatriement de la quantité:

Private Sub TextBox1_AfterUpdate()
Dim pl As Range 'déclare la variable pl (PLage)
Dim x As Byte 'déclare la variable x (incrément)
Dim Trouve As Range
Dim temp As String
If Me.TextBox1.Value = "" Then Exit Sub 'sort de la procédure si la TextBox1 est vide
  
'définit la plage pl (cellules éditées de la colonne A)
Set pl = Sheets("Accueil").Range("A2:A" & Range("A" & Rows.Count).End(xlUp))
temp = pl.Address
Set Trouve = pl.Find(Right("00" & (Me.TextBox1.Value), 13), lookat:=xlWhole)

If Not Trouve Is Nothing Then
li = Trouve.Row 'définit la ligne li (si aucune occurrence trouvée, génère une erreur)
Else
    If ajout = True Then Exit Sub      'sort de la procédure
    'sélectionne le texte de la TextBox1
    Me.TextBox1.SelStart = 0 'début de la sélection
    Me.TextBox1.SelLength = Len(Me.TextBox1.Value) 'longueur de la selection
    MsgBox "Gencode invalide"
    Exit Sub 'sort de la procédure
End If 'fin de la condition

TextBox2.Text = Cells(li, 3)

Me.TextBox2.SetFocus 'place le curseur dans la TextBox2 (Quantité)
Me.TextBox2.SelStart = 0 'début de la sélection
Me.TextBox2.SelLength = Len(Me.TextBox2.Value) 'longueur de la sélection

End Sub

 

[seblap47]

Re : incrémenter / décrémenter

merci beaucoup