Incrémenter / décrémenter

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

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

Bonsoir,

une partie de réponse :

Private Sub CommandButton5_Click()
TextBox2.Value = TextBox2.Value + 1
End Sub

Private Sub CommandButton6_Click()
TextBox2.Value = TextBox2.Value - 1
If TextBox2.Value < 0 Then TextBox2.Value = 0
End Sub

avec cela, vous pouvez incrémenter et décrémenter la valeur de la textbox.

Une vérif "négative" est faite !

Ensuite pour la copie des données, vous avez oubliez que votre feuille est protégée, et comme vous êtes sous "on error resume next" VBA ne vous le signale pas.... donc :

Private Sub CommandButton1_Click() 'bouton "Valider"
Dim x As Byte 'déclare la variable x

If modif = True Or ajout = True Then
    For x = 1 To 2 'boucle sur les 2 textboxes

        Me.Controls("TextBox" & x).Value = Cells(li, x).Value
    Next 'prochaine Textbox de la boucle
Else
    On Error Resume Next
    Application.EnableEvents = False
    ActiveSheet.Unprotect    Cells(li, 3).Value = CInt(Me.TextBox2.Value) 'répercute la quantité dans la cellule
    ActiveSheet.Protect
    Application.EnableEvents = True
    On Error GoTo 0
End If

Unload Me 'vide et ferme l'UserForm1
UserForm1.Show 'affiche l'Userform1

End Sub

et

Private Sub CommandButton2_Click() 'bouton "Modifier"
modif = True 'définit la variable modif
    On Error Resume Next
   Application.EnableEvents = False
    ActiveSheet.Unprotect
    Cells(li, 3).Value = CInt(Me.TextBox2.Value) 'répercute la quantité dans la cellule
    ActiveSheet.Protect
    Application.EnableEvents = True
    On Error GoTo 0
End Sub

J'ai rajouté "Application.EnableEvents=False", car votre feuille est sous surveillance en cas de changement de valeur dans une cellule.

C'est plus propre et cela évite d'engendrer des problème, car ça peut lancer des macros qu'on ne veut pas spécialement lancer !

Sur mon fichier j'ai également modifié la procédure de la textbox1 avec une "validation" automatique à 13 caractère entrés, soit je ne me suis pas lancer dans la gestion d'un code non existant, mais cela évite une manipulation à l'utilisateur...

Private Sub TextBox1_Change()

If Len(TextBox1.Value) = 13 Then
    Dim pl As Range
    Set pl = Range(Cells(2, 1), Cells(Application.Rows.Count, 1).End(xlUp))
    On Error Resume Next
    li = pl.Find(Me.TextBox1.Value, , xlValues, xlWhole).Row
    TextBox2.Text = Cells(li, 3)
ElseIf Len(TextBox1.Value) > 13 Then
    TextBox1.Value = Left(TextBox1.Value, 13)
End If

End Sub

à ce moment là il faut retirer la gestion :

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)
'
'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 = Range(Cells(2, 1), Cells(Application.Rows.Count, 1).End(xlUp))
'On Error Resume Next 'gestion des erreurs, en cas d'erreur passe à la ligne suivante
'li = pl.Find(Me.TextBox1.Value, , xlValues, xlWhole).Row 'définit la ligne li (si aucune occurrence trouvée, génère une erreur)
'If Err > 0 Then 'condition : si une erreur a été générée
'    If ajout = True Then 'condition : si la variable ajout est "Vrai"
'        Exit Sub 'sort de la procédure
'    End If
'    '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
'On Error GoTo 0
'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

@ bientôt

LouReeD

Bonsoir,

Merci beaucoup, je vais étudier votre code.

Cordialement