criscris11
XLDnaute Accro
Bonjour à tous,
J'espère que vous avez tous passé de bonnes vacances.
J'utilise dans un USF une recherche intuitive via un textbox mais je me suis rendu compte qu'après avoir saisie la première lettre, je perds le focus du textbox ce qui est embêtant car la recherche peut être réalisée sur plusieurs lettres ce qui m'oblige et recliquer dans le Textbox pour saisir la deuxième lettre.
Voici le code attaché :
Merci de bien vouloir me dire pourquoi je perds le focus.
Bonne rentrée et bonne journée à tous.
J'espère que vous avez tous passé de bonnes vacances.
J'utilise dans un USF une recherche intuitive via un textbox mais je me suis rendu compte qu'après avoir saisie la première lettre, je perds le focus du textbox ce qui est embêtant car la recherche peut être réalisée sur plusieurs lettres ce qui m'oblige et recliquer dans le Textbox pour saisir la deuxième lettre.
Voici le code attaché :
Code:
'_______________________________________________________'
'A chaque changement dans la zone de recherche intuitive
'(mise à jour des zones de texte)
'_______________________________________________________'
Private Sub TextBox1_Change()
Dim xCell As Range, Nbr As Long, ligne As Long
Dim L As Byte
Me.ListBox1.Clear
Erase NomOK
For Each xCell In Range(Sheets("Base gestion MDR").[F9], Sheets("Base gestion MDR").[F65000].End(xlUp))
If UCase(xCell) Like UCase(Me.TextBox1) & "*" Then
Me.ListBox1.AddItem
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 0) = xCell & " " & xCell.Offset(0, 1)
ReDim Preserve NomOK(1 To Me.ListBox1.ListCount)
NomOK(Me.ListBox1.ListCount) = xCell.Row
End If
Next xCell
If Me.ListBox1.ListCount > 0 Then
Me.ListBox1.ListIndex = 0
ligne = Me.ListBox1.ListIndex + 1
Me.Label62.Caption = ListBox1.ListCount
Me.TextBox2.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "F")
Me.TextBox3.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "G")
Me.TextBox4.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "E")
Repertoire = ThisWorkbook.Path
If Dir(Repertoire & "\" & Me.TextBox4 & ".gif") <> "" Then
Me.Image2.Picture = LoadPicture(Repertoire & "\" & Me.TextBox4 & ".gif")
Else
On Error Resume Next
'Me.Image2.Picture = LoadPicture(Répertoire & "\" & "transparent.gif")'permet de rajouter un fond transparent pour les images autres qu'en format .gif
End If
Me.TextBox5.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "W")
Me.TextBox6.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "C")
Me.TextBox6.Value = Format(TextBox6.Value, "00"" ""000"" ""00000") 'format personnalisé identique aux cellules de la feuille de calcul
Me.TextBox7.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "B")
Me.TextBox7.Value = Format(TextBox7.Value, "00000000")
Me.TextBox8.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "D")
If Dir(Repertoire & "\" & Me.TextBox8 & ".gif") <> "" Then
Me.Image3.Picture = LoadPicture(Repertoire & "\" & Me.TextBox8 & ".gif")
ElseIf Me.TextBox8.Value = "BCL/GARDE" Then
Me.Image3.Picture = LoadPicture(Repertoire & "\" & "BCL" & ".gif")
ElseIf Me.TextBox8.Value = "PASS/FANFARE" Or Me.TextBox8.Value = "FI" Then
Me.Image3.Picture = LoadPicture(Repertoire & "/" & "Transparent" & ".gif")
On Error Resume Next
'Me.Image3.Picture = LoadPicture(Répertoire & "\" & "transparent.gif")'permet de rajouter un fond transparent pour les images autres qu'en format .gif
End If
Me.TextBox9.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "H")
Me.TextBox10.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "I")
Me.TextBox11.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "L")
Me.TextBox12.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "K")
Me.TextBox13.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "M")
Me.TextBox14.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "Q")
Me.TextBox15.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "R")
Me.TextBox16.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "S")
Me.TextBox17.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "V")
Me.TextBox20.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "Y")
Me.TextBox21.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "X")
Me.TextBox23.Value = Me.TextBox21.Value + 1
Me.TextBox24.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "AL")
Me.TextBox25.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "AM")
Me.Label34.Caption = Sheets("Base gestion MDR").Cells(NomOK(ligne), "AN")
Me.Label36.Caption = Sheets("Base gestion MDR").Cells(NomOK(ligne), "AO")
Me.TextBox26.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "AF")
If TextBox26.Value <= CDate(Date) Then
TextBox26.BackColor = RGB(255, 0, 0)
Me.CommandButton9.Visible = True
ElseIf TextBox26.Value >= CDate(Date) + 1 And TextBox26.Value <= CDate(Date) + 7 Then
TextBox26.BackColor = RGB(255, 102, 0)
Me.CommandButton9.Visible = False
Else
TextBox26.BackColor = RGB(255, 255, 255)
Me.CommandButton9.Visible = False
End If
Me.TextBox27.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "AG")
Me.Label40.Caption = Sheets("Base gestion MDR").Cells(NomOK(ligne), "AH")
Me.Label42.Caption = Sheets("Base gestion MDR").Cells(NomOK(ligne), "AI")
Me.TextBox29.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "AQ")
Me.TextBox30.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "AS")
Me.TextBox31.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "BB")
If TextBox31.Value = "TDM" Then
TextBox31.BackColor = RGB(0, 0, 255) 'fond bleu marine si TDM
TextBox31.ForeColor = RGB(255, 255, 0) 'couleur de police jaune (or) si TDM
Else
TextBox31.BackColor = RGB(255, 255, 255) 'fond blanc si différent de TDM
TextBox31.ForeColor = RGB(0, 0, 0) 'couleur de police noire si différent de TDM
End If
Me.TextBox32.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "BD")
Me.TextBox33.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "BH")
Me.TextBox34.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "BE")
Me.TextBox35.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "BF")
Me.TextBox36.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "BG")
Me.TextBox37.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "AT")
If Sheets("Base gestion MDR").Cells(NomOK(ligne), "AW") = "F" Then
Me.TextBox38.Value = "Féminin"
Me.TextBox38.BackColor = RGB(255, 153, 204)
Else
Me.TextBox38.Value = "Masculin"
Me.TextBox38.BackColor = RGB(153, 204, 255)
End If
Me.TextBox39.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "AU")
Me.TextBox40.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "AV")
Label57.Caption = "ans"
Me.TextBox41.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "AX")
Me.TextBox42.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "AZ")
Me.TextBox43.Value = Sheets("Base gestion MDR").Cells(NomOK(ligne), "BA")
'Me.Label77.Caption = Sheets("Base gestion MDR").Cells(NomOK(ligne), "BQ")
For L = 1 To 6
With Me.Controls("Label" & 63 + L)
.Caption = Sheets("Base gestion MDR").Cells(NomOK(ligne), 60 + L)
Select Case .Caption
Case "Oui"
.BackColor = RGB(0, 255, 0)
Case "Ajourné"
.BackColor = RGB(255, 102, 0)
Case "Abandon", "Echec"
.BackColor = RGB(255, 0, 0)
Case Else
.BackColor = RGB(255, 255, 255)
.Caption = "Non"
End Select
End With
Next L
If Sheets("Base gestion MDR").Cells(NomOK(ligne), "N") = "" And Sheets("Base gestion MDR").Cells(NomOK(ligne), "P") = "" Then
Label75.Caption = "Période probatoire terminée"
Label75.BackColor = RGB(0, 255, 0)
Label75.Height = 20
ElseIf CDate(Sheets("Base gestion MDR").Cells(NomOK(ligne), "N")) > CDate(Date) Then
Label75.Caption = "Fin de la période probatoire le" & " " & Sheets("Base gestion MDR").Cells(NomOK(ligne), "N")
Label75.BackColor = RGB(255, 102, 0)
Label75.Height = 20
ElseIf Sheets("Base gestion MDR").Cells(NomOK(ligne), "P") <> "" Then
Label75.Caption = "Période probatoire renouvelée pour" & " " & Sheets("Base gestion MDR").Cells(NomOK(ligne), "O") & " " & "jusqu'au" & " " & Sheets("Base gestion MDR").Cells(NomOK(ligne), "P")
Label75.BackColor = RGB(255, 0, 0)
Label75.Height = 42
End If
End If
ListBox1_Change
End Sub
Merci de bien vouloir me dire pourquoi je perds le focus.
Bonne rentrée et bonne journée à tous.