Probleme dans ma macro
bonjour
j'ai un probleme avec ma macro,
je rentre d'abord un mot de passe ensuite j'ai une fenetre qui apparait qui demande l'accord soit OK ou NOK
si Ok je copie la cellule F46 dans le classeur liste en colonne T en fonction de la ligne
si NOk il y aune fenetre qui apparait pour motif
le motif doive être copie dans le classeur liste colonne W
Je n'arrive pas a comprendre mon erreur
voici la macro
Sub QUALITE()
Dim Mdp As String, accord As String, motif As String
Mdp = Application.InputBox("Veuillez introduire votre mot de passe")
If Mdp <> "1" Then MsgBox "Accès refusé !": Exit Sub
accord = Application.InputBox("OK ou NOK")
If accord <> "OK" Then motif = Application.InputBox("motif") ': Exit Sub
N° = Range("H8").Value
Set Cel = Sheets("liste").Range("A:A").Find(N°, lookat:=xlWhole)
If Not Cel Is Nothing Then
Sheets("liste").Range("W" & Cel.Row).Value = motif
'Exit Sub
End If
'Sheets("liste").Range("W" & Cel.Row).Value = motif
'Exit Sub
If Range("F46").Value = "" Then
MsgBox " Saisissez une date Qualité !", 16
End
End If
N° = Range("H8").Value
Set Cel = Sheets("liste").Range("A:A").Find(N°, lookat:=xlWhole)
If Not Cel Is Nothing Then
Sheets("liste").Range("S" & Cel.Row).Value = "Qualite"
Sheets("liste").Range("T" & Cel.Row).Value = Range("I8").Value
End If
Sheets("etat imprimante").Select
ActiveWorkbook.Save
Exit Sub
End Sub
Je cois que mon probleme vient des exit sub et des end if
Pouvez vous m'aider
Bonjour,
une proposition d'adaptation
Sub QUALITE()
Dim Mdp As String, accord As String, motif As String
Mdp = Application.InputBox("Veuillez introduire votre mot de passe")
If Mdp <> "1" Then MsgBox "Accès refusé !": Exit Sub 'accès refusé on arrête
accord = Application.InputBox("OK ou NOK")
If accord <> "OK" Then ' ce n'est pas ok , on demande un motif , et on le sauve en colonne W, pour le Numero trouvé en H8
motif = Application.InputBox("motif")
N° = Range("H8").Value
Set Cel = Sheets("liste").Range("A:A").Find(N°, lookat:=xlWhole)
If Not Cel Is Nothing Then Sheets("liste").Range("W" & Cel.Row).Value = motif
ElseIf Range("F46").Value = "" Then ' si la cellule F46 est vide on arrête
MsgBox " Saisissez une date Qualité en F46!", 16: Exit Sub
Else 'sinon on copie l'info I8 en colonne T pour le numéro trouvé en H8
N° = Range("H8").Value
Set Cel = Sheets("liste").Range("A:A").Find(N°, lookat:=xlWhole)
If Not Cel Is Nothing Then
Sheets("liste").Range("S" & Cel.Row).Value = "Qualite"
Sheets("liste").Range("T" & Cel.Row).Value = Range("I8").Value
End If
End If ' ici cela dépend de ce que tu veux faire, pas possible de se faire une idée sur base de ton code.
Sheets("etat imprimante").Select
ActiveWorkbook.Save
End Sub
Bonjour
Merci
j'aurai encore besoin de vous
voici la macro Option Explicit
Dim T, C, D, DerLn
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A3:A" & Application.Max(3, Range("A" & Rows.Count).End(xlUp).Row))) Is Nothing Then
Sheets("etat imprimante").Range("H8").Value = Target.Value
Sheets("etat imprimante").Range("D41") = Sheets("etat imprimante").Range("I7").Value
Sheets("etat imprimante").Range("F46") = Sheets("etat imprimante").Range("I9").Value
Sheets("etat imprimante").Select
'copie P1 dans D41
'.Range("P1").Select
'Selection.Copy
'Range("D41").Select
'ActiveSheet.Paste
'Range("P7").Select
'Application.CutCopyMode = False
End If
End Sub
Private Sub OptionRefusé_Click()
T = "REFUSE"
Call MiseAjour
End Sub
Private Sub Optionencours_Click()
T = "EN COURS"
Call MiseAjour
End Sub
Private Sub Optionterminer_Click()
T = "TERMINER"
Call MiseAjour
End Sub
Private Sub OptionQUALITE_Click()
T = "NOK"
Call MiseAjour
End Sub
Sub MiseAjour()
If T = "NOK" Then ' je voudrais afficher que les en cours avec les nok
Application.ScreenUpdating = False
DerLn = Range("A" & Rows.Count).End(xlUp).Row
Range("A3:W" & DerLn + 1).ClearContents
Application.DisplayAlerts = False
With Sheets("liste")
For Each C In .Range("S3:S" & Application.Max(3, .Range("S" & Rows.Count).End(xlUp).Row))
If UCase(C.Value) = T Then
DerLn = Range("A" & Rows.Count).End(xlUp).Row
.Range("A" & C.Row & ":W" & C.Row).Copy
Range("A" & DerLn + 1).PasteSpecial xlPasteAll
End If
Next C
End With
Application.CutCopyMode = False
Range("A2").Select
End If
If T <> "NOK" Then ' affiche soit les en cours ou les terminer ou les refuse
Application.ScreenUpdating = False
DerLn = Range("A" & Rows.Count).End(xlUp).Row
Range("A3:W" & DerLn + 1).ClearContents
Application.DisplayAlerts = False
With Sheets("liste")
For Each C In .Range("P3:P" & Application.Max(3, .Range("P" & Rows.Count).End(xlUp).Row))
If UCase(C.Value) = T Then
DerLn = Range("A" & Rows.Count).End(xlUp).Row
.Range("A" & C.Row & ":W" & C.Row).Copy
Range("A" & DerLn + 1).PasteSpecial xlPasteAll
End If
Next C
End With
Application.CutCopyMode = False
Range("A2").Select
End If
End Sub
le probleme c'est que je souhaite trier en un clic soit
terminer cela fonctionne
En cours cela fonctionne
refusé cela fonctionne
NOk ne fonctionne pas ( je voudrais qu'il m'affiche les en cours + les nok et actuelement il m'affiche les NOk + en cours + refusé)
Bonjour,
désolé le code n'est pas en soi suffisant pour comprendre ce qu'il faut corriger. Comment puis-je déterminer une action en cours ? sur base de quelle valeur dans quelle colonne ?