XL 2019 Remplissage d'une feuille via évènement de feuille

[Pieerre69]

Bonjour,

Dans le cadre d'un projet pro, je cherche à créer une liste via les évènements de feuilles.
Dans le fichier joint, j'ai une liste de composants pour un produit fini :
-> en cliquant sur le bouton "produire", j'incrémente un produit fini, testez le jusqu'à 3-4 produits
-> en temps normal (j'ai fais sauté toutes les protections pour que vous puissiez intervenir), l'utilisateur ne peux pas sélectionner les cellules tant qu'il n'a pas appuyé sur le bouton "déclarer un manquant".
-> quand vous appuierez dessus, la colonne B:B sera disponible à la sélection. En faisant des clics droits dessus, vous sélectionnez/déselectionnez la ligne et le composant comme un manquant, et le reste du programme ne les prendra pas en compte pour la suite (qui n'est pas compris dans ce fichier test).

J'aimerais que pour chaque composant mis en rouge (ou sélectionné), le programme copie le code article, la désignation et la quantité unitaire dans la feuille "Etiquette" sous la liste des manquants.

J'ai testé de faire ce code, mais ça ne copie colle pas les données et ça ne "désélectionne" plus la target..
Pouvez-vous m'aider ?

Merci d'avance,

Pierre

PS: si je n'ai pas été assez clair dites le moi! C'est peut-être compliqué d'y comprendre quelque chose quand on a pas la tête dedans.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim couleurs()
Dim etat()
Dim nb As Integer

If Worksheets(Wfeuil).Cells(10, 10) = 0 Then
    nb = 5
    Exit Sub

    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        nb = 5
        couleurs = Array(RGB(255, 0, 0), RGB(255, 255, 255))
        'etat = Array("", "x")
        On Error GoTo color
        Target.Interior.color = couleurs(Application.WorksheetFunction.Match(Target.Interior.color, couleurs, 0) Mod 2)
        Cells(Target.Row, 8).Interior.color = Target.Interior.color
        If Target.Interior.ColorIndex = 3 Then
            Cells(Target.Row, 8) = "0"
            Else
            Cells(Target.Row, 8) = Worksheets("Production").Cells(13, 9) * Worksheets("Production").Cells(Target.Row, 5)
        End If
        Cancel = True
        Worksheets("Etiquette").Cells(nb, 14).Value = Worksheets(Wfeuil).Target.Value
        Worksheets("Etiquette").Cells(nb, 16).Value = Worksheets(Wfeuil).Cells(Target.Row, 4).Value
        Worksheets("Etiquette").Cells(nb, 23).Value = Worksheets(Wfeuil).Cells(Target.Row, 5).Value
        nb = nb + 1
    End If
    Exit Sub
color:
    Target.Interior.color = couleurs(0)
    Cancel = True
    
    'If Target.Interior.color = RGB(255, 0, 0) Then
    '    Cells(Target.Row, Target.Column) = "x"
    '    Else
    '    Cells(Target.Row, Target.Column) = ""
    'End If
End If
End Sub

 

[Bebere]

bonjour
à tester

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim couleurs()
    Dim etat()
    Dim nb As Long, ws As Worksheet

    'If Worksheets(Wfeuil).Cells(10, 10) = 0 Then
    '    nb = 5
    '    Exit Sub

    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        Set ws = Worksheets("Etiquette")
        If ws.Range("N5") = "" Then nb = 5 Else nb = ws.Range("N" & Rows.Count).End(xlUp).Row + 1
        couleurs = Array(RGB(255, 0, 0), RGB(255, 255, 255))
        'etat = Array("", "x")
        On Error GoTo color
        Target.Interior.color = couleurs(Application.WorksheetFunction.Match(Target.Interior.color, couleurs, 0) Mod 2)
        Cells(Target.Row, 8).Interior.color = Target.Interior.color
        If Target.Interior.ColorIndex = 3 Then
            Cells(Target.Row, 8) = "0"
        Else
            Cells(Target.Row, 8) = Cells(13, 9) * Cells(Target.Row, 5)
        End If
        Cancel = True
        ws.Cells(nb, 14).Value = Target.Value    'Worksheets(Wfeuil).
        ws.Cells(nb, 16).Value = Cells(Target.Row, 4).Value
        ws.Cells(nb, 23).Value = Cells(Target.Row, 5).Value
        nb = nb + 1
    End If
    Exit Sub
color:
    Target.Interior.color = couleurs(0)
    Cancel = True

    'If Target.Interior.color = RGB(255, 0, 0) Then
    '    Cells(Target.Row, Target.Column) = "x"
    '    Else
    '    Cells(Target.Row, Target.Column) = ""
    'End If
    'End If
End Sub

 

[Pieerre69]

Salut bebere,

Pour ce que j'avais demandé, le code marche bien.
J'aimerais complexifié la tâche en supprimant la ligne du tableau de la feuille "Etiquette" lorsque je désélectionne une cellule.

Avant que vous répondiez aujourd'hui je m'étais dit que je pouvais faire un array dynamique qui contiendrait les positions (via la fonction Target) des cellules sélectionnées.

Lorsque l'on désélectionnerai une cellule, on fait une rechercheX des coordonnées de la cellule dans l'array pour supprimer la ligne.

Je ne sais pas si c'est assez explicite.

J'ai essayé de faire quelque chose, mais je ne maîtrise pas les arrays donc ça ne fonctionne pas du tout.

Peut-être que la solution que j'ai imaginé n'est pas la meilleure, j'attend votre retour