modifier formulaire de recherche

[nina71287]

Bonjour,

J'aurais besoin de votre aide j'ai trouvé ce formulaire de recherche ci joint le code j'ai réussi à l'adapter à mes données sauf que lorsque l'on cherche un mot qui n'existe pas cela provoque une erreur. j'ai essayé de placé un Go to erreur
erreur: msgbox"le mot recherché n'existent pas" le soucis c'est qui s'affiche tous le temps meme quand le mot est trouvé. Quelqu'un peut il me dire ou il faudrait que je le place. Merci d'avance pour votre aide

bonne journée

Dim f, nbCol, pointeur, ligne
Private Sub UserForm_Initialize()
Set f = Sheets("BD")
ligne = 2
nbCol = f.[A1].CurrentRegion.Columns.Count
x = 11
y = 15
For i = 1 To nbCol
retour = Me.Controls.Add("Forms.Label.1", "Label" & i, True)
Me("label" & i).Caption = f.Cells(1, i)
Me("label" & i).Top = y
Me("label" & i).Left = x
retour = Me.Controls.Add("Forms.TextBox.1", "TextBox" & i, True)
Me("textbox" & i).Top = y
Me("textbox" & i).Left = x + 30
Me("textbox" & i).Width = f.Columns(i).Width + 4
'Me("textbox" & i).Value = f.Cells(ligne, i)
y = y + 20
Next
retour = Me.Controls.Add("Forms.Label.1", "Label" & i, True)
Me("label" & i).Caption = f.Cells(1, 1)
Me("label" & i).Top = Me.ListBox1.Top - 10
Me("label" & i).Left = Me.ListBox1.Left + 2
'--
For i = 2 To f.[A65000].End(xlUp).Row
Me.ListBox1.AddItem
Me.ListBox1.List(i - 2, 0) = f.Cells(i, 1)
Me.ListBox1.List(i - 2, 1) = i
Next
pointeur = 1
If nbCol > 8 Then Me.Height = y + 30
pointeur = 0
ligne = Me.ListBox1.List(pointeur, 1)
affiche
End Sub

Private Sub ListBox1_Click()
ligne = Me.ListBox1.Column(1)
pointeur = Me.ListBox1.ListIndex
affiche
End Sub

Private Sub b_suiv_Click()
If pointeur < Me.ListBox1.ListCount - 1 Then
pointeur = pointeur + 1
ligne = Me.ListBox1.List(pointeur, 1)
affiche
End If
End Sub

Private Sub b_prec_Click()
If pointeur > 0 Then
pointeur = pointeur - 1
ligne = Me.ListBox1.List(pointeur, 1)
affiche
End If
End Sub

Private Sub b_premier_Click()
pointeur = 0
ligne = Me.ListBox1.List(pointeur, 1)
affiche
End Sub

Private Sub b_dernier_Click()
pointeur = Me.ListBox1.ListCount - 1
ligne = Me.ListBox1.List(pointeur, 1)
affiche
End Sub

Private Sub B_ok_Click()
Me.ListBox1.Clear
i = 0
Set plage = f.[A1].CurrentRegion
Set c = plage.Find(Me.MotCle, , , xlPart)
If Not c Is Nothing Then
premier = c.Address
Do
Me.ListBox1.AddItem
lig = c.Row
Me.ListBox1.List(i, 0) = plage.Cells(lig, 1)
Me.ListBox1.List(i, 1) = lig
i = i + 1
Set c = plage.FindNext(c)
Loop While Not c Is Nothing And c.Address <> premier
End If
pointeur = 0
ligne = Me.ListBox1.List(pointeur, 1)
affiche
End Sub

Private Sub b_tout_Click()
Me.ListBox1.Clear
For i = 2 To f.[A65000].End(xlUp).Row
Me.ListBox1.AddItem
Me.ListBox1.List(i - 2, 0) = f.Cells(i, 1)
Me.ListBox1.List(i - 2, 1) = i
Next
pointeur = 0
ligne = Me.ListBox1.List(pointeur, 1)
affiche
End Sub

Sub affiche()
For i = 1 To nbCol:
Me("textbox" & i).Value = f.Cells(ligne, i)
w = Evaluate("Cell(""format""," & f.Cells(ligne, i).Address & ")")
If Left(w, 1) = "C" Then Me("textbox" & i).Value = Format(f.Cells(ligne, i), "0000.00 €")
Next i
End Sub

 

[jp14]

Re : modifier formulaire de recherche

Bonjour


Code a tester

Private Sub B_ok_Click()
Me.ListBox1.Clear
i = 0
Set plage = f.[A1].CurrentRegion
'Set c = plage.Find(Me.MotCle, , , xlPart)
Set c = plage.Find("toto1", , , xlPart)
If Not c Is Nothing Then
premier = c.Address
Do
Me.ListBox1.AddItem
trouve = True
lig = c.Row
Me.ListBox1.List(i, 0) = plage.Cells(lig, 1)
Me.ListBox1.List(i, 1) = lig
i = i + 1
Set c = plage.FindNext(c)
Loop While Not c Is Nothing And c.Address <> premier
End If
If trouve = False Then
Call MsgBox("" & "" _
            & vbCrLf & "Non trouvé" _
            , vbInformation, Application.Name)
    Exit Sub
End If
pointeur = 0
ligne = Me.ListBox1.List(pointeur, 1)
affiche
End Sub

JP

 

[nina71287]

Re : modifier formulaire de recherche

ca marche trés bien merci beaucoup🙂