Perte de focus après saisie de la première lettre

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
criscris11

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é :
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.
 
Trier par date Trier par votes
Re : Perte de focus après saisie de la première lettre

Bonjour criscris11,

Pour répondre à ta question : parce que...

Tu dois savoir déjà que, passé 3-4 lignes de code,il devient trop fastidieux de chercher l'origine d'un problème!

Il serait donc utile que tu joignes un fichier reproduisant le problème, ne crois-tu pas?

A te lire.

Cordialement.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Perte de focus après saisie de la première lettre

Bonjour Papou-net,
Merci de te pencher sur mon problème. Pour ce qui est d'envoyer un fichier, il va falloir que j'y aille à coup de tronçonneuse car il fait environ 6 Mo : je vais essayer d'extraire le minimum et d'envoyer l'extraction.
Bon après-midi.

PS : le problème pourrait-il venir d'un autre code : dans ce cas là, il faudrait que je laisse les code entier du USF ?
 
Vote positif 0 Vote négatif
Re : Perte de focus après saisie de la première lettre

Bonjour le fil, bonjour le forum,

Même constat que Papou-net. Peut-être en faisant tourner ta macro pas à pas. Tu mets un point d'arrêt sur la première ligne du code, tu lance la macro puis tu avances ligne par ligne avec la touche [F8]. Sinon egarde aussi du coté des propriétés AutoTab et MaxLength de la Textbox. Car en combinant les deux True et 1 on peut perdre le focus dès que le premier caractère est édité...
 
Vote positif 0 Vote négatif
Re : Perte de focus après saisie de la première lettre

Bonjour à tous,

Comme mes camarades je n'ai pas épluché ton code qui est trop long.
J'ai juste vérifié qu'il n'y a pas de Exit Sub quelque part.
Pourquoi ne pas mettre un TextBox1.SetFocus avant le End Sub ?
 
Vote positif 0 Vote négatif
Re : Perte de focus après saisie de la première lettre

Re,
Cela ne marche pas même avec le TextBox1.SetFocus avant le End Sub.

En regardant le problème de plus près, la perte de focus intervient quand la ListBox d'affichage change et en voici le code (moins long) 😱 :
Code: 
Private Sub ListBox1_Change()
Dim ligne As Long
If ListBox1.ListIndex < 0 Then
  Label30 = "":  Me.TextBox2 = "":  Me.TextBox3 = "":  Me.TextBox4 = ""
Else
  ligne = Me.ListBox1.ListIndex + 1
  If Cells(NomOK(ligne), "E") = "SDT" And IsDate(Cells(NomOK(ligne), "Z")) Then
    Label30 = "Elévation à la distinction de première classe à compter du " & Cells(NomOK(ligne), "Z")
    Label30.BackColor = &HC000&
  ElseIf Cells(NomOK(ligne), "E") = "1CL" And Cells(NomOK(ligne), "AA") = "Oui" Then
    Label30 = "Remplit les conditions pour l'avancement au grade de caporal"
    Label30.BackColor = &H80FF&
  ElseIf Cells(NomOK(ligne), "E") = "CPL" And Cells(NomOK(ligne), "AB") = "Oui" Then
    Label30 = "Remplit les conditions pour l'avancement au grade de caporal-chef"
    Label30.BackColor = &H80FF&
  ElseIf Cells(NomOK(ligne), "E") = "CCH" And IsDate(Cells(NomOK(ligne), "AC")) Then
    Label30 = "Elévation à la distinction de caporal-chef de première classe à compter du " & Cells(NomOK(ligne), "AC")
    Label30.BackColor = &HC000&
  Else
    Label30 = ""
    Label30.BackColor = &HFFFFFF
  End If
End If
End Sub

Je vais essayer d'être plus clair : je tape la première lettre et je perds le focus car la liste a "bougée", je reprends le focus et tape la deuxième lettre et là 2 cas de figures ; si la liste ne bouge pas, je garde le focus et si la liste bouge je reperds le focus.
Je vais essayer de vous faire un petit exemple d'après mon fichier sur une dizaine de noms.
 
Vote positif 0 Vote négatif
Re : Perte de focus après saisie de la première lettre

Re,
Au départ j'ai ma liste qui s'initialise par rapport à mes noms qui ne sont pas toujours dans l'ordre alphabétique suivant le tri dans l'onglet source.
Je recherche mon nom par exemple (je vais prendre mon prénom cela sera plus simple) donc je tape "C" dans le Textbox donc je perds le focus. La liste se réduit avec tous mes noms commençant par C. Je reprends le focus et je tape "H" après le "C" : si la première occurrence de la liste commence par "CH" je garde le focus sinon je le perds. Voilà en espérant avoir été un peu plus explicite : pb de tri ou d'ordre dans la ListBox ?

Bon après-midi.
 
Vote positif 0 Vote négatif
Re : Perte de focus après saisie de la première lettre

Bonjour le fil, bonjour le forum,

Pourquoi ne pas effectuer la totalité du code uniquement quand la recherche est effectuée ? À la sotie de la TextBox1 par exemple. Ça éviterait de faire tous les changements chaque fois que tu rajoutes une lettre...
En pièce jointe un exemple tout simple pour te guider...
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Perte de focus après saisie de la première lettre

Re à tous,
Ok et merci Robert. Je faire des essais et essayer de simplifier au mieux le code en fonction de tes conseils.
Je vous tiendrai au courant de toute façon.

Encore merci à tous et bonne soirée.
 
Vote positif 0 Vote négatif
Re : Perte de focus après saisie de la première lettre

Bonsoir à tous,

Comme promis, je viens aux nouvelles. J'ai réussi en partie à modifier mes codes pour arriver à mes fins grâce à tous vos conseils.
Mais de mon côté (car j'en ai marre de chiner des codes à droite à gauche), je me suis dégoté de derrière les fagots (et le mot est faible) l'excellente bible de Mr Spreedcheet (pour ne pas nommer John Walkenbach) "VBA pour Excel 2003". Quand je disais de derrière les fagots : rupture chez l'éditeur, plus aucun exemplaire dans les librairies mêmes spécialisées... et puis j'ai trouvé un exemplaire (en français en plus) d'occasion (un seul sur toute la toile).
Donc maintenant plus d'excuses mais la route va être longue à la vue des 1000 pages que contient cette bible mais je savais à quoi m'attendre et puis il n'est jamais trop tard pour apprendre, non ?
Bon je vais vous laisser car j'ai quelques nuits blanches qui m'attendent.
En tous cas, encore merci à toutes et à tous pour votre entraide chaleureuse.
Bonne soirée et au plaisir.
 
Vote positif 0 Vote négatif
Re : Perte de focus après saisie de la première lettre

Bonjour à tous,

Suite à ce post et les bons conseils des intervenants, j'ai revu les codes mais je sèche sur un point : en fait c'est un problème de mise à jour sur l'évènement ListBox_Change (enfin je suppose).
J'ai pu extraire une petite partie des données afin de concocter un petit fichier ou le problème est expliqué.

Merci d'avance et bonne soirée à tous.
 

Pièces jointes

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

F
  • Question Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
540
Francky79
F
lynyrd
  • Question Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
833
AtTheOne
AtTheOne
F
  • Question Question
XL 2019 erreur 1004
Réponses
8
Affichages
601
florian50470
F
R
  • Question Question
Microsoft 365 Couleur de fond de textbox [CLOTURE]
Réponses
2
Affichages
854
romubzh35
R
P
  • Question Question
XL 2019 VBA moteur de recherche
2
Réponses
21
Affichages
2 K
philgood54000
P
A
  • Question Question
XL 2010 Contrôles dans USF avant ajout
Réponses
5
Affichages
736
Oneida
Oneida
Nico2978
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
970
Nico2978
Nico2978
G
  • Question Question
Microsoft 365 Réduire la taille de la macro ?
Réponses
9
Affichages
948
Staple1600
Staple1600
G
  • Question Question
Microsoft 365 Incompatibilité de type - Array
Réponses
2
Affichages
762
guiyom
G
L
  • Résolu(e)
XL 2019 Formulaire Excel - TxtBox avec couleur de la celle associée
Réponses
4
Affichages
724
Lindsay_RBD
L
C
  • Résolu(e)
XL 2013 afficher image dans Userform via HyperText
Réponses
5
Affichages
876
Cyril-neo
C
O
  • Question Question
XL 2019 Je veux afficher mes données dans ma Listbox1 avec l'entete de ma Base donnée et fait la recherche sans que cela derange l'entete.
Réponses
6
Affichages
924
ChTi160
ChTi160
M
  • Résolu(e)
Microsoft 365 Sélection ligne dans ListBox avec boutons précédent-suivant
4 5 6
Réponses
88
Affichages
5 K
meyscal
M
G
  • Résolu(e)
XL 2016 VBA : Copie d'une ligne après application d'un filtre
Réponses
7
Affichages
1 K
gfgghbhg
G
A
  • Question Question
XL 2019 ajout automatique de quantités de sortie de stock au méme produit existant deja au tableau
Réponses
3
Affichages
1 K
vgendron
vgendron
K
  • Résolu(e)
XL 2019 Copier Seulement les lignes affichée après un filtre de tableau
Réponses
9
Affichages
2 K
Kushi
K
B
  • Question Question
XL 2013 Interdire saisie de doublon et faire synthèse à chaque saisie
Réponses
5
Affichages
634
BIROULIG
B
GADENSEB
  • Question Question
Microsoft 365 Macro .XLA découpage de fichiers à passer en X64
Réponses
8
Affichages
860
GADENSEB
GADENSEB
CGU2022.
  • Résolu(e)
XL 2013 Userform recherche - Listbox double clic renvoi vers cellule
Réponses
7
Affichages
1 K
CGU2022.
CGU2022.
eastwick
  • Question Question
XL 2016 conservation du format de la date
Réponses
3
Affichages
632
Dranreb
Dranreb
Retour