XL 2016 Création d'un formulaire Recherche

[Lindsay_RBD]

Bonjour à tous ! 😁

Afin de simplifier un fichier dans mon entreprise, je souhaite créer un formulaire. Voici ce que j'essaye tant bien que mal à faire :

Lorsque je clique sur le bouton "Recherche", le formulaire s'ouvre ✅ C'est ok
Je renseigne le numéro de lot que je cherche, puis je clique sur "Recherche".
Lorsque je clique sur "Recherche", ma référence se met automatiquement (ligne 6; colonne où est le numéro de lot) + la désignation (ligne 7; colonne où est le numéro de lot) + la couleur du statut (si la recherche n'aboutit pas alors rouge, sinon couleur de la cellule du numéro de lot).

Je vous joins le fichier pour que vous puissiez voir visuellement ce que j'essaye de faire.
Merci par avance pour votre aide ! 👏

 

[GALOUGALOU]

re Lindsay_rbd bonjour le forum
un début de réponse, qui ne répond pas en totalité à votre problématique, mais bon, c'est un départ

Private Sub btn_rechercher_Click()
Dim sel As Range

Sheets("Suivi des lots").Select

        Set sel = Sheets("Suivi des lots").Range("f9:f3000").Find(Me.NumLotMatiere.Value, , xlValues, xlWhole)
    
    If sel Is Nothing Then
        MsgBox "Recherche absente"
    Else
        sel.Activate
         ActiveWindow.ScrollRow = ActiveCell.Row
         
    End If
End Sub

cdt
galougalou

 

[Lindsay_RBD]

re Lindsay_rbd bonjour le forum
un début de réponse, qui ne répond pas en totalité à votre problématique, mais bon, c'est un départ

Private Sub btn_rechercher_Click()
Dim sel As Range

Sheets("Suivi des lots").Select

        Set sel = Sheets("Suivi des lots").Range("f9:f3000").Find(Me.NumLotMatiere.Value, , xlValues, xlWhole)
   
    If sel Is Nothing Then
        MsgBox "Recherche absente"
    Else
        sel.Activate
         ActiveWindow.ScrollRow = ActiveCell.Row
        
    End If
End Sub

cdt
galougalou

Merci beaucoup pour ton retour qui m'a permis d'avancer !

J'ai un peu modifier ton code afin de me rapprocher un peu plus de ce que je souhaite.

Private Sub btn_rechercher_Click()
Dim sel As Range

Sheets("Suivi des lots").Select

        Set sel = Sheets("Suivi des lots").Range("C9:BT19").Find(Me.NumLotMatiere.Value, , xlValues, xlWhole)
    
    If sel Is Nothing Then
        [B]ColorStatutLot.BackColor = RGB(255, 0, 0)[/B]
    Else
       [B]RefMatiere = Range(Rows("6"), Columns("sel")).Value
        DesignMatiere = Range(Rows("7"), Columns("sel")).Value[/B]
        
    End If
End Sub

Dorénavant, il m'affiche bien le statut en rouge si je ne possède pas le lot dans mon tableau.
Si le lot est bien présent dans le tableau, il active la cellule en question. Toutefois, je souhaiterai qu'il remplisse le reste de mon formulaire avec les données des lignes 6 et 7 mais il m'indique comme erreur "Mémoire insuffisante" pour la partie de code :
RefMatiere = Range(Rows("6"), Columns("sel")).Value
DesignMatiere = Range(Rows("7"), Columns("sel")).Value

 

[GALOUGALOU]

re
je ne suis pas un grand spécialiste tant s'en faut, mais perso j'aurais écrit le code comme ça

Private Sub btn_rechercher_Click()
Dim sel As Range, col As Long

Sheets("Suivi des lots").Select
On Error Resume Next 'éviter une erreur si "co = sel column" ne trouve pas la colonne
        Set sel = Sheets("Suivi des lots").Range("C9:BT19").Find(Me.NumLotMatiere.Value, , xlValues, xlWhole)
    col = sel.Column 'identifier la colonne correspondante au résultat de recherche
  
    If sel Is Nothing Then
       StatutLot.BackColor = RGB(255, 0, 0) '[/B]
    Else
   RefMatiere = Cells(6, col).Value ' [B]
     DesignMatiere = Cells(7, col).Value '[/B]
        StatutLot.BackColor = vbWhite
      
    End If
End Sub

chez moi ce code semble fonctionner, les textbox récupèrent les informations, la dernière se colore de rouge si aucunes données n'est trouvées
cdt
galougalou

 

[ChTi160]

Bonsoir Lindsay_RBD ,GALOUGALOU
N'y a t'il pas une erreur de colonne
Sur cette ligne?

DesignMatiere = Cells(6, col).Value '

Ne devrait il pas y avoir 7 comme ligne ?
Jean marie

 

[GALOUGALOU]

re chti160
certainement exact, correction faite dans le fil 4
cdt
galougalou

 

[ChTi160]

Bonjour
le code de GALOUGALOU Complété

Private Sub btn_rechercher_Click()
Dim sel As Range, col As Long
Sheets("Suivi des lots").Select
On Error Resume Next 'éviter une erreur si "co = sel column" ne trouve pas la colonne
        Set sel = Sheets("Suivi des lots").Range("C9:BT19").Find(Me.NumLotMatiere.Value, , xlValues, xlWhole)
    col = sel.Column 'identifier la colonne correspondante au résultat de recherche    
    If sel Is Nothing Then
           StatutLot.BackColor = RGB(255, 0, 0) '[/B]
    Else
   RefMatiere = Cells(6, col).Value ' [B]
     DesignMatiere = Cells(7, col).Value '[/B]
      With StatutLot
           .BackColor = vbWhite 'On colore en blanc
           'ci dessous on colore en fonction de ce qui est ou non trouvé
           .BackColor = IIf(sel.Interior.ColorIndex = 50, &HC000&, _
                             IIf(sel.Interior.ColorIndex = 45, &H80FF&, &HFF&))
      End With
    End If
End Sub

jean marie

 

[Lindsay_RBD]

Merci à vous deux ! Cela fonctionne à merveille ! 👌🤩

J'ai juste fait une modification

Private Sub btn_rechercher_Click()
Dim sel As Range, col As Long
Sheets("Suivi des lots").Select
On Error Resume Next 'éviter une erreur si "co = sel column" ne trouve pas la colonne
        Set sel = Sheets("Suivi des lots").Range("C9:BT19").Find(Me.NumLotMatiere.Value, , xlValues, xlWhole)
    col = sel.Column 'identifier la colonne correspondante au résultat de recherche   
    If sel Is Nothing Then
           StatutLot.BackColor = RGB(255, 0, 0) '[/B]
    Else
   RefMatiere = Cells(6, col).Value ' [B]
     DesignMatiere = Cells(7, col).Value '[/B]
      With ColorStatutLot
           'ci dessous on colore en fonction de ce qui est ou non trouvé
           .BackColor = IIf(sel.Interior.ColorIndex = 50, &HC000&, _
                             IIf(sel.Interior.ColorIndex = 45, &H80FF&, &HFF&))
      End With
    End If
End Sub

J'ai juste fait une modification ligne 14. J'ai modifié "StatutLot" par "ColorStatutLot" ☺️
Encore merci en tout cas !

 

[ChTi160]

Re
Super !
jean marie