Frm de recherche VBA

bonjour à tous,

Je me permet de poster un message car depuis plusieurs jours je suis sur un colle et je ne comprend vraiment pas comment faire et c'est la fin de mon projet il ne me reste plus que ça.

La demande concerne la page intitulée "rapport d'expansion"

Pour quelqu'un qui connaît le VBA il n'y a pas grand chose a trouver mais pour moi ça me paraît impossible.

J'ai créer un formulaire de recherche (userform) j'ai relié toutes les plage comme vous pourrez le voir dans le fichier Excel ci-joint ou dans le code ci-dessous

Le formulaire fonctionne sauf quand je créer une nouvelle feuille qui est associé au bouton macro dont le code est ci dessous également et bien mon formulaire de recherche ce met à ne plus chercher dans la bonne colonnes.

Merci infiniment a celui qui trouvera ma colle.

Et si ce n'est pas trop demandé quel code pourrai-je introduire pour que quand le "numero de lot" n'existe pas il arrête de chercher à l'infini et me met un message d'erreur (le numero de lot n'existe pas)

Et vraiment sa c'est du plus le code pour pouvoir effacer avec la toucher effacer la case intitulé (LE NUMERO DE LOT)

Merci infiniment à celui qui arrivera à resoudre ce problème cela me permettrait de finaliser la réalisation de mon projet que je dois donné la semaine prochaine.

Voici le code du FRM de recherche :

Private Sub UserForm_Initialize()

Me.Message_lbl = "Veuillez inscrire le numéro de lot concernant la production à rechercher"

End Sub

Private Sub lenumerodelot_Change()

'se positionner'

Feuil3.Activate

Range("H5").Select

'on boucle tous les lots de la colonne H'

Do Until ActiveCell = CLng(Me.lenumerodelot)

ActiveCell.Offset(1, 0).Select

Loop

Me.lesdates = ActiveCell.Offset(0, -7)

Me.les_operateurs = ActiveCell.Offset(0, 21)

Me.qualiteprogramee = ActiveCell.Offset(0, -6)

Me.matierepremiere = ActiveCell.Offset(0, -4)

Me.laquantite = ActiveCell.Offset(0, -1)

Me.expansionunoudeux = ActiveCell.Offset(0, 1)

Me.expanseurlist = ActiveCell.Offset(0, 3)

Me.heurededebut = ActiveCell.Offset(0, 4)

Me.heuredefin = ActiveCell.Offset(0, 5)

End Sub

Private Sub btn_fermer_Click()

Unload Me

End Sub

Voici le code de la macro pour ouvrir une nouvelle feuille (car c'est pour être à prendre en considération) :

Sub NOUVELLE_FEUILLE_DE_PRODUCTION()

ActiveSheet.Unprotect

Range("A1:AE35").Copy

Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 40).Select

ActiveSheet.Paste

Range("B1:B3").ClearContents

Range("A5:N30").ClearContents

Range("E32:N34").ClearContents

ActiveWindow.Zoom = 55

Range("A1").Select

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

Et un photo pour ceux ou celle qui ne souhaite pas telecharger le fichier pour montrer sa composition :

Très cordialement

Bonjour,

Voici un essai d'adaptation du code si j'ai bien compris :

Private Sub UserForm_Initialize()
Me.Message_lbl = "Veuillez inscrire le numéro de lot concernant la production à rechercher"
tctrl = array("lesdates", "les_operateurs", "qualiteprogramee", "matierepremiere", "laquantite", _
              "expansionunoudeux", "expanseurlist", "heurededebut", "heuredefin")
tCol = array(1, 29, 2, 4, 7, 9, 11, 12, 13)
for i = lbound(tCtrl) to ubound(tCtrl) 'boucle d'assignation des colonnes correspondant aux contrôles
    me.controls(tCtrl(i)).tag = tCol(i)
next i
End Sub

Private Sub lenumerodelot_Change()
with Feuil3
    dl = .cells(.rows.count, "H").end(xlup).row
    if application.countif(.range("H5:H" & dl), CLng(Me.lenumerodelot)) > 0 then
        Ligne = application.match(CLng(Me.lenumerodelot), .range("H5:H" & dl), 0)
        for each ctrl in me.controls
            if ctrl.tag <> "" then ctrl = .cells(Ligne, ctrl.tag).value
        next ctrl
        lenumerodelot.specialeffect = 2
    else
        for each ctrl in me.controls
            if ctrl.tag <> "" then ctrl = ""
        next ctrl
        lenumerodelot.borderline = 1: lenumerodelot.bordercolor = vbred
    end if
end with
End Sub

Private Sub btn_fermer_Click()
Unload Me
End Sub
Sub NOUVELLE_FEUILLE_DE_PRODUCTION()
with ActiveSheet
    .Unprotect
    nvl = .Range("A" & .Rows.Count).End(xlUp).Row + 40
    .Range("A1:AE35").Copy .Range("A" & nvl)
    .Range("B1:B3, A5:N30, E32:N34").ClearContents
    .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
end with
End Sub

Cdlt,

Merci pour ton retour voila ce qu'il m'est inscrit.

N'hésite pas à essayer sur ma feuille car tu comprendra surement mieux que moi les deboguages

Excuse moi j'avais mal copié le code .

voila ce qui m'est inscrit

Bonjour,

Aucun souci. Peux-tu remplacer borderline par borderstyle ?

Cdlt,