Aide pour une macro Fermé

Question

Bonjour à tous

Je souhaite faire une GMAO (Gestion de maintenance assisté par ordinateur).
J'ai essayé de faire une macro en faisant plein de recherches sur Internet mais j'ai du mer** quelque part.
Ce que je veut de cette macro: (Je prend exemple de la ligne 6, ça peut être une autre ligne)

Quand un "X" est inscrit en I6 une "MsgBox" me demande si j'ai bien enlevé les pièces utilisées du stock :
-Si oui, une "inputbox" s'affiche me demandant qui est intervenu et la réponse s'inscrit en H6
-Si non, il m’affiche la feuille "stock" et la macro s’arrête la)

Puis, je veux que la ligne 6 soit supprimée pour être placée dans la feuille "Historique des biens" tout en haut du tableau.

J'espère que je me suis bien expliquer (si ce n'est pas le cas n'hésitez pas à me dire ce que vous n'avez pas compris)
Je vous mets la macro ainsi que le tableau si besoin :


    Private Sub Worksheet_Change(ByVal Target As Range)    Dim CPTR_Ligne As String, CPTR_Boucle01 As String, Resultat As String, N°Ligne As String, Ma_Plage As Range    CPTR_Ligne = Range("K1")    CPTR_Boucle01 = 1    N°Ligne = 6    If Range("K2") = 1 Then        While CPTR_Boucle01 >= CPTR_Ligne            If Cells(N°Ligne, 9) = X Then                If MsgBox("Êtes-vous sûr d'avoir enlevé les pièces utilisées du stock?", vbYesNo + vbQuestion) = vbYes Then                Resultat = InputBox("Qui est intervenu sur cette opération?", vbQuestion)                Cells(N°Ligne, 8) = Resultat                Set Ma_Plage = Range("A" & N°Ligne & ":I" & N°Ligne)                Ma_Plage.Select                Selection.Copy                Sheets("Historiqu").Select                Rows("6:6").Select                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove                Range("B6").Select                ActiveSheet.Paste                Sheets("Travaux").Select                Else                Cells(N°Ligne, 9).ClearContents                Sheets("Stock").Select                Exit Sub                End If            Else            CPTR_Boucle01 = CPTR_Boucle01 + 1            N°Ligne = N°Ligne + 1            End If        Wend    Else    End If    End Sub

Pour le tableau:
https://forum.excel-pratique.com/download/file.php?id=154985



Je remercie par avance toutes les personnes qui prendront du temps pour m’aider dans mon projet.

michel_m · Answer

Bonjour,

mais j'ai du mer** quelque part

Ca on sait tous faire!    ;o)

et si tu nous disais sur quel ligne ou quel principe ca mer**?
.

michel_m · Answer

effectivement ca ne risquait pas de fonctionner. essaies:

Option Explicit'----------------------------------Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)    If Not Intersect(Target, Range("I6:I100")) Is Nothing Then    Target.Value = "X"End IfEnd Sub'--------------------------------------Private Sub Worksheet_Change(ByVal Target As Range)Dim Resultat As String, N°Ligne As Byte, Bloc        N°Ligne = Target.Row        If Target = "X" Then            'demande confirmation et identité opérateur            If MsgBox("Êtes-vous sûr d'avoir enlevé les pièces utilisées du stock?", vbYesNoCancel + vbQuestion) = vbNo Then GoTo refus1                Resultat = InputBox("Qui est intervenu sur cette opération?", vbQuestion)                Cells(N°Ligne, 8) = Resultat            If Resultat = "" Then GoTo refus2            ' recopie données du travail effectué dans l'historique            Bloc = Range("A" & N°Ligne & ":I" & N°Ligne)             With Sheets("Historiqu")                .Rows(6).Insert                .Range("B6").Resize(1, 9) = Bloc                .Activate            End With    End IfExit Sub    'gestionnaire erreursrefus1:    Target = ""Exit Subrefus2:    Target = ""    MsgBox "Nom de l'opérateur non précisé!", vbCriticalEnd Sub

Aide pour une macro

2 réponses

Discussions similaires