Voila je mets mon code afin que d'autres puisse s'en inspirer
Private Sub CommandButton3_Click()
Dim Var As String
On Error Resume Next
Var = InputBox("Vérifier si le nom est repertorié. Eviter les accents", , "")
'pour ne rien supprimer en cas d' ECHAP ou D'ANNULER
If Var = "" Then Exit Sub
Set mottrouvé = [A:A].Find(What:=Var)
If Not mottrouvé Is Nothing Then
If CDate(mottrouvé.Offset(0, 4).Value) > Format(Date, "dd/mm/yyyy") Then
'faire exception de renouvelement d'article
Style = vbYesNo + vbDefaultButton1
Msg = "Voulez vous faire une exception ?"
Title = "Cette personne ne peut renouveler l'article"
Réponse = MsgBox(Msg, Style, Title)
If Réponse = vbYes Then
mottrouvé.EntireRow.Delete
GoTo macro
End If
Else
'confirmer le renouvelement
Style = vbYesNo + vbDefaultButton1
Msg = "Voulez vous faire un renouvelement ?"
Title = "Renouvelement d'un article"
Réponse = MsgBox(Msg, Style, Title)
If Réponse = vbYes Then
mottrouvé.EntireRow.Delete
MsgBox "Le renouvelement est possible. Ouverture du formulaire de saisies"
macro:
UserForm1.Show
'Macro enregistrée le 24/09/2007 par Stagiaire
Rows("6:6").Select
Selection.Insert Shift:=xlDown
Rows("7:7").Select
Selection.Copy
Rows("6:6").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("E6").Select
ActiveCell.FormulaR1C1 = ""
Range("E7").Select
Selection.AutoFill Destination:=Range("E6:E7"), Type:=xlFillDefault
End If
End If
End If
End Sub
j'ai juste un petit problème sur la ligne en gras. si le nom n'existe pas dans mon tableau, cela me renvoi directement sur end if. j'aimerai que cela me renvoi sur la ligne macro:
j'ai essayé avec un goto mais cela ne fonctionne pas.