Userform trop lent

Résolu/Fermé
Tourdumond Messages postés 17 Date d'inscription lundi 16 mai 2016 Statut Membre Dernière intervention 2 septembre 2016 - Modifié par pijaku le 17/05/2016 à 08:36
Tourdumond Messages postés 17 Date d'inscription lundi 16 mai 2016 Statut Membre Dernière intervention 2 septembre 2016 - 19 mai 2016 à 17:11
Boujour à tous et un grand merci, à tous ceux qui donnent de leur temps pour nous aider.
Je suis nouveau sur le forum, novice en VBA.
Je vous pose mon problème, j'ai un bouton recherche sur ma feuille excel, je click dessus, ce qui m'ouvre un userform, mais depuis quelque temps, il est très lent.
Est-ce-que mon code est trop lourd ou peut-être mal composé, ci dessous mon code

Private Sub ListBoxLocataire_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ligSelect = ListBoxLocataire.Column(6, ListBoxLocataire.ListIndex)
    usfAffichage.Show
    
End Sub

Private Sub RechercheC2_Change()
intTopIndex = Me.RechercheC2.TopIndex
    ' Rechercher les données en fonction des critères sélectionnés
    Call Rechercher
End Sub


'------------------ComboBox MouseWheel----------------------------
Private Sub RechercheC1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  ' Définir les noms des objet à l'ouverture de l'USF
  ' sont utilisés dans le code du hook
  Set ObjUSF = Me: Set ObjList = Me.RechercheC1
  'Store the first TopIndex Value
  intTopIndex = Me.RechercheC1.TopIndex
  '
  Hook_Mouse
End Sub

' Check to see if focus is lost
Private Sub RechercheC1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  UnHook_Mouse
End Sub


'------------------ComboBox MouseWheel----------------------------
Private Sub RechercheC2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  ' Définir les noms des objet à l'ouverture de l'USF
  ' sont utilisés dans le code du hook
  Set ObjUSF = Me: Set ObjList = Me.RechercheC2
  'Store the first TopIndex Value
  intTopIndex = Me.RechercheC2.TopIndex
  '
  Hook_Mouse
End Sub

' Check to see if focus is lost
Private Sub RechercheC2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  UnHook_Mouse
End Sub

Private Sub ListBoxLocataire_Change()
  intTopIndex = Me.ListBoxLocataire.TopIndex
End Sub

Private Sub ListBoxLocataire_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  UnHook_Mouse
End Sub

Private Sub ListBoxLocataire_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  ' Définir les noms des objet à l'ouverture de l'USF
  ' sont utilisés dans le code du hook
  Set ObjUSF = Me: Set ObjList = Me.ListBoxLocataire
  'Store the first TopIndex Value
  intTopIndex = Me.ListBoxLocataire.TopIndex
  '
  Hook_Mouse
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  UnHook_Mouse
End Sub
Private Sub UserForm_Initialize()
    ' déclaration de la variable
    Dim j As Integer
    With Sheets("stock")
        Application.ScreenUpdating = False

    'récupérer les données de la colnne B
        For j = 2 To Sheets("stock").Range("B" & .Rows.Count).End(xlUp).Row
           RechercheC1 = Sheets("stock").Range("B" & j)
            If .Range("B" & j) <> "" Then
    

        'filtrer les doublons
        If RechercheC1.ListIndex = -1 Then RechercheC1.AddItem Sheets("stock").Range("B" & j)
            End If
        Next j
    End With
    
    Dim i As Integer
    With Sheets("stock")
        Application.ScreenUpdating = False

    'récupérer les données de la colnne D
        For i = 2 To Sheets("stock").Range("D" & .Rows.Count).End(xlUp).Row
           RechercheC2 = Sheets("stock").Range("D" & i)
            If .Range("D" & i) <> "" Then
    

        'filtrer les doublons
        If RechercheC2.ListIndex = -1 Then RechercheC2.AddItem Sheets("stock").Range("D" & i)
            End If
        Next i
    End With
End Sub

Private Sub RechercheC1_Change()
intTopIndex = Me.RechercheC1.TopIndex
    ' Rechercher les données en fonction des critères sélectionnés
    Call Rechercher
End Sub

Private Sub Rechercher()
    ' Rechercher les données en fonction des critères 1 et 2
    Dim rCel As Range
    Dim lgLig As Long
    Dim lgLigDeb As Long
    
    Dim reference As String
    Dim code As String
    Application.ScreenUpdating = False

    reference = "*"
    If RechercheC1.Value <> "" Then reference = RechercheC1.Value
    code = "*"
    If RechercheC2.Value <> "" Then code = RechercheC2.Value
    
    ListBoxLocataire.Clear

    ' Boucle de la 2me à la dernière ligne de la feuille Feuil1
    For lgLigDeb = 2 To Range("A" & Rows.Count).End(xlUp).Row
        If Range("B" & lgLigDeb).Value Like reference And Range("D" & lgLigDeb).Value Like code Then
            With ListBoxLocataire
                .AddItem Range("A" & lgLigDeb).Value
                .List(.ListCount - 1, 1) = Range("B" & lgLigDeb).Value
                .List(.ListCount - 1, 2) = Range("C" & lgLigDeb).Value
                .List(.ListCount - 1, 3) = Range("D" & lgLigDeb).Value
                .List(.ListCount - 1, 4) = Range("E" & lgLigDeb).Value
                .List(.ListCount - 1, 5) = Range("F" & lgLigDeb).Value
                .List(.ListCount - 1, 6) = lgLigDeb
                
                lgLig = lgLig + 1
            End With
        End If
    Next lgLigDeb
End Sub


Merci à ceux qui voudront bien m'aider, car je suis un peu perdu.

2 réponses

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 754
17 mai 2016 à 08:42
Bonjour,

1- tu ne nous donnes pas tout le code (ou sont les procédures Hook_Mouse et UnHook_Mouse? ou est déclarée la variable intTopIndex, etc...)
2- Qu'est ce qui est lent? La recherche? L'ouverture de l'UserForm?
3- A quoi sert cet UserForm?

Pour pouvoir répondre à toutes ces questions, un petit fichier anonymisé ne serait pas de trop...

Pour joindre un fichier sur les forums de ccm il faut :
> se rendre sur le site : https://www.cjoint.com/
> cliquer sur "Parcourir"
> rechercher le fichier
> cliquer sur "Ouvrir"
> cliquer sur "Créer le lien Cjoint"
> copier le lien
> revenir ici le coller dans une réponse

0
Tourdumond Messages postés 17 Date d'inscription lundi 16 mai 2016 Statut Membre Dernière intervention 2 septembre 2016
17 mai 2016 à 17:50
Bonjour et merci de m'avoir répondu
Je vous mets le lien https://www.cjoint.com/c/FErpDsNxRs6 vous arriverez à mieux comprendre, car c'est vrai que je me suis mal exprimé, mais c'est la première que je post et je savais pas trop quoi mettre.
Cela va servir en logistique pour des entrées et sorties de palettes.
Et encore merci
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 754 > Tourdumond Messages postés 17 Date d'inscription lundi 16 mai 2016 Statut Membre Dernière intervention 2 septembre 2016
18 mai 2016 à 09:03
Bonjour,

As tu besoin du "scroll" dans tes combobox et / ou listbox???
0
Tourdumond Messages postés 17 Date d'inscription lundi 16 mai 2016 Statut Membre Dernière intervention 2 septembre 2016 > pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024
18 mai 2016 à 17:07
Bonjour
oui, j'aurai bien voulu le gardé
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 754
Modifié par noctambule28 le 20/05/2016 à 10:28
Bonjour,

Voilà le fichier en retour :
[Supprimé à la demande du demandeur pour info personnelle]

La méthode de remplissage des Combobox a été grandement améliorée en terme de vitesse grâce à des variables Objet dictionary.
De plus, j'ai modifié les événements déclencheurs de l'affichage dans la listbox en remplaçant RechercheC1_Change() et RechercheC2_Change() par RechercheC1_Click() et RechercheC2_Click().
J'ai laissé tout le reste.
Résultat, ton userform s'affiche en moins d'une seconde contre 43 avant...

Avant, j'arrivais jamais à finir mes phrases... mais maintenant je
0
Tourdumond Messages postés 17 Date d'inscription lundi 16 mai 2016 Statut Membre Dernière intervention 2 septembre 2016
19 mai 2016 à 17:11
Bonjour
Le fichier est super, c'est exactement ce que je cherchais.
je vous envoi mes plus sincères remerciement .

Cordialement
0