Macro qui solde des mesures

Bonjour!

Je suis toujours dans mon stage et j'ai un problème sur un assez gros fichier, je vous synthétise son fonctionnement pour que vous compreniez le problème:

Le programme permet de réaliser des demandes de mesures, on peut cocher plusieurs surfaces et caractéristiques:

Les surfaces et les caractéristiques (si il y en a plyusieurs) s'affichent sur une ligne en dessous, comme ceci:

Sur la feuille "résultats", est désormais indiqué qu'il y a une mesure en cours:

Quans un opérateur change la valeur (avec la liste déroulante), et met "Terminé", la mesure est soldée et passe dans les "pièces terminées" sur la feuille "demande", seulement, quand il ya plusieurs surfaces, seule la première ligne s’efface...

La partie de code correspondante se trouve dans "Private Sub WorksheetsChange Résultats".

Bonjour YannisB,

J'ai ouvert ton fichier, afin de résoudre ton problème ( pour ma part) il va falloir un peu de temps car ton code est vraiment redondant, il pourrait être beaucoup plus allégé que ça notamment en utilisant des Objets, des bloc "With" et des Boucles.

Dans l'état actuel pour un éventuel dépannage ou une modif tu passeras je ne sais pas combien de temps à te rappeler le fonctionnement de ton code, alors imagine pour nous qui partons de 0.

Si je trouve du temps dans la journée, je te montrerais comment allégé ton code mais de ton coté essaye de chercher aussi pour le rendre plus lisible et plus compréhensible.

Quand tu code un certain nombres de ligne comme tu as pu le faire, penses toujours au dépannage ou à une modif, fait tout pour passer le moins de possible. Je te l'accorde tu as commenté ton code et c'est déjà une bonne chose

Merci de ta réponse, oui en effet étant novice j'ai du mal pour simplifier mon code

Je comprend que ça peut être compliqué pour qqn qui n’est ^pas dans le projet c'est pour que j'essaie d'expliquer au maximum le fonctionnement avec des screen etc...

En tout cas merci pour le temps que tu y accordera!

Avant de commencer à régler ton problème commençons par essayer de simplifier ton code.

Voici un exemple de simplification a tester pour une meilleure lisibilité:

Code simplifié:

Private Sub Worksheet_Change(ByVal Target As Range)  'Quand la feuille (Worksheet) change, ce programme se lance
    Dim Ws_demande As Worksheet
    Dim i&, n&, y&
    Dim x As Double

        Set Ws_demande = Sheets("Demande")
        y = 5

        Call Cloche

        If Target.Count > 1 Then Exit Sub
        If Target = "Terminé" Then Target.Interior.Color = RGB(50, 200, 100) 'Si RAS la cellule devient verte
                'ActiveCell.Font.ColorIndex = 51

        For Each Cell In Range("J7:P10")
            If Cell.Value = "" Then Cell.Interior.Color = xlColorIndexNone    'Enleve la couleur des cellules vides
        Next Cell

        If Not Intersect(Target, Range("J7:P9")) Is Nothing Then
            Call Heures(Target.Column)   'Si les cellules qui changent sont J7 ou J8

            For i = 4 To 20
                With Ws_demande
                    If .Range("F" & i).Value = 600 Then  'On cherche les pièces de la machine à mesurer
                        For col = 9 To 12
                            .Cells(4, col) = .Cells(i, col - 8) 'Transmet les données vers les pièces terminées
                        Next col

                        For col = 14 To 16
                            .Cells(4, col) = Format(Time, "h:mm;@") ' pour donner un format à la cellule avant d'y écrire
                        Next col

                        .Range("O4").Value = .Range("H" & i).Value
                        .Range("M4").Value = .Range("E" & i).Value
                        .Range("P4") = CDate(.Range("N4")) - CDate(.Range("G" & i)) 'Temps pris pour mesurer

                        x = .Range("H" & i) - CDate(.Range("P4")) 'Compare le temps mis au temps attendu

                        .Range("Q4").Value = IIf(x > 0, "Avance", "Retard")
                        x = IIf(x > 0, x, -x)

                        .Range("R4").Value = Format(Time, "h:mm;@") 'Donne un format à la cellule
                        .Range("R4").Value = x 'Prend la vameur de l'écart entre temps attendu et temps mis

                        For n = i + 1 To n = i + 10
                            If .Range("B" & n) = "" Then
                                .Rows(y).Insert
                                .Rows(y).Locked = False
                                .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
                                n = n + 1
                                .Range("L" & y) = .Range("D" & n).Value
                                .Range("M" & y) = .Range("E" & n).Value
                                n = n + 1
                                y = y + 1
                            End If
                        Next n

                        .Range(.Cells(i, 1), .Cells(i, 8)).ClearContents 'Vide les pièces à mesurer
                        .Rows(4).Insert
                        .Rows(4).Locked = False
                        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True
                    End If
                End With
            Next i
        End If
End Sub

Et ça à mettre dans ton module "Affichagerésultat" :

Sub Heures(colonne)
Sheets("Demande").Cells(10, colonne-3) = Format(Time, "h\Hmm") 'Affiche l'heure au format voulu dans la cellule
End Sub

Dans la feuille "Résultats" si tu renomme tous tes boutons de "bouton10" à "bouton16" tu pourrais aussi simplifier ton code:

Tu peux supprimer tous tes codes de bouton individuelles :

Sub EffacerColonneJ()
'
' EffacerColonneJ Macro
'
msgboxJ = MsgBox("Voulez vous vraiment effacer la colonne 600? ", vbOKCancel, "Confirmation")

If msgboxJ = vbOK Then

    Range("J7:J10").ClearContents 'Efface colonne J

    End If
'
End Sub

Par ceci, qui est général pour tous les boutons :

Sub EffacerColonne()
    Dim N_col As Integer
    Dim Val

    N_col = CInt(Right(Application.Caller, 2))
    Val = MsgBox("Voulez vous vraiment effacer la colonne " & ActiveSheet.Cells(6, N_col) & "? ", vbOKCancel, "Confirmation")
    If Val = vbOK Then ActiveSheet.Range(Cells(7, N_col), Cells(10, N_col)).ClearContents 'Efface colonne
End Sub

J'ai mis ce que tu me conseillais de mettre dans le worksheets change résultats mais les changements de couleur ne se font plus et les heures ne s'affichent plus Il fallait bien tout supprimer avant de mettre ton code?

EDIT: Voila le fichier:

Oui, il fallait bien tout supprimer. Quand tu parles de couleur, ce sont les couleurs de quels onglets ? car moi je t'ai simplifié le code du worksheet_change de la feuille "Résultats".

Oui c'est bien sur la feuille "résultats", normalement quand il y a "En cours" la cellule est orange et quand il y a "Terminé" la cellule est verte. Et aussi quand la valeur "Terminé" est donnée à une cellule, la mesure est soldée sur la feuille demande et l'heure de fin de mesure s'affiche en dessous.

Je viens de faire l'essai, j'ai bien les couleurs orange ou vert suivant le statut mais en effet il manque l'heure

Oui mais la police reste rouge quand c'est "terminé" et les mesures de la feuille demande ne se soldent plus

Pour l'heure il faut que tu corriges ce code:

Sub Heures(colonne)
Sheets("Résultats").Cells(10, colonne) = Format(Time, "h\Hmm") 'Affiche l'heure au format voulu dans la cellule
End Sub

Et pour la couleur de police tu réactive cette ligne car actuellement elle est en commentaire

ActiveCell.Interior.Color = RGB(50, 200, 100)

Top! Ca marche pour l'heure

EDIT: Merci pour la police, erreur bête de ma part, j'aurais du le voir

Aussi j'ai remarqué un autre truc, quand j'ai des cases terminées et que je vide le tableau les cases restent vertes

Voici dans un 1er temps un fichier pas mal allégé en code à essayer:

Ps : j'ai corrigé l'erreur de ton dernier post

Merci de ton travail

J'ai juste remarqué un petit problème, en plus du soldage de mesure, c'est que peu importe la machine qu’on choisi, le "En cours" se met dans la colonne de la machine 600

Erreur de ma part dans une variable :

Avec ce fichier aucune mesure ne se met en cours, j'ai essayer pour la Famir, la schaudt et la 600

En tous cas un grand merci pour le temps que tu y passe!!! Ca m'aide beaucoup

Une nouvelle version, j’espère que celle là sera la bonne