IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Remplacer ProgressBar par Label


Sujet :

Macros et VBA Excel

  1. #1
    Membre chevronné
    Profil pro
    Inscrit en
    Novembre 2007
    Messages
    473
    Détails du profil
    Informations personnelles :
    Localisation : France, Vendée (Pays de la Loire)

    Informations forums :
    Inscription : Novembre 2007
    Messages : 473
    Par défaut Remplacer ProgressBar par Label
    Bonjour le forum!

    Je viens vers vous, car j'ai un fichier qui va sur plusieurs poste! J'ai un ptit code qui fonctionne bien, mais comme vous allez le voir il peu demander un peu de temps! Pour faire patienter la personne j'ai mis un progressbar, mais le problème est que toutes les ordinateurs ne sont pas équipé pour celui-ci!

    Et comme le ne souhaite pas leurs proposer une installation de "component" je voulais faire un label en lui faisant augmenter sa longueur. ds mon exemple il s'intitule "LabPRB.Width"

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    Sub ReCherche_Ecritures()
    Dim DéBit, CréDit, SolDE As String
        DéBit = 0
        CréDit = 0
        SolDE = 0
        GL.ProB1 = 0
        LabPRB.Width = 0 ' label de progressbar
        GL.ProB1.Visible = True
        GL.Image1.Visible = True
     
     Dim NbLgne As Variant
        Dim i, j, Y As Integer
        Dim K, P
        Dim TesteR, Teste2 As Boolean
        Dim U As Byte
        GL.ListBox1.Clear
     
        NbLgne = Sheets("Récap ").Range("a65000").End(xlUp).Row
        'Sheets("feuil2").Range("b27") = NbLgne
    For i = 2 To NbLgne + 1
      ' on regarde pour les analyt
     TesteR = False
     If GL.ToUs = True Then
      TesteR = True
      GoTo fin1
      End If
     
     
     
         For Y = 0 To GL.ListBox3.ListCount - 1
     
            If Val(GL.ComptAnal.Value) = 0 And GL.TousAnal.Caption = "Sans analyt." And GL.ToUs = False Then
     
     
            If Cells(i, 5) = "" Then TesteR = True             Exit For
             End If
     
     
            If Val(GL.ComptAnal.Value) > 0 Then
     
            If GL.ListBox3.Selected(Y) = False Then TesteR = False
            If GL.ListBox3.Selected(Y) = True And Cells(i, 5) Like GL.ListBox3.List(Y) Then
                TesteR = True
                Exit For
            End If
     
     
     
            End If
          Next Y
    fin1:
     
     
          If Val(GL.comp.Value) > 0 Then
            For j = 0 To GL.ListBox2.ListCount - 1
            Teste2 = False
            If Cells(i, 9) = GL.ListBox2.List(j) Then
                Teste2 = True
     
                Exit For
                End If
     
              Next j
          End If
     
          If Val(GL.comp.Value) = 0 Then
            Teste2 = False
            If Cells(i, 9) = GL.ComboBox6.Value Then Teste2 = True
          End If
          If GL.ComboBox6.Text = "" Then Teste2 = True
     
    If Cells(i, 10) <> "" And Cells(i, 10) <> 0 And TesteR = True And Teste2 = True _
          And Cells(i, 9) Like UCase(GL.Tst1.Text) & "*" _
          And Cells(i, 1) Like UCase(GL.Tst3.Text) & "*" _
          And Cells(i, 12) Like UCase(GL.Tst4.Text) & "*" _
          And Cells(i, 6) Like "*" & UCase(GL.Tst2.Text) & "*" Then
           GL.ListBox1.AddItem
           GL.ListBox1.List(K, 0) = Sheets("Récap ").Cells(i, 2)
           GL.ListBox1.List(K, 1) = "| " & Sheets("Récap ").Cells(i, 3)
           GL.ListBox1.List(K, 2) = "| " & Sheets("Récap ").Cells(i, 5)
           GL.ListBox1.List(K, 3) = "| " & Sheets("Récap ").Cells(i, 6)
           GL.ListBox1.List(K, 4) = "| " & Sheets("Récap ").Cells(i, 7)
           GL.ListBox1.List(K, 5) = "| " & Sheets("Récap ").Cells(i, 9)
           GL.ListBox1.List(K, 6) = "| " & Sheets("Récap ").Cells(i, 8)
           GL.ListBox1.List(K, 7) = "| " & Sheets("Récap ").Cells(i, 30)
            DéBit = DéBit + Sheets("Récap ").Cells(i, 30)
           GL.ListBox1.List(K, 8) = "| " & Sheets("Récap ").Cells(i, 29)
            CréDit = CréDit + Sheets("Récap ").Cells(i, 29)
           GL.ListBox1.List(K, 9) = "| " & Sheets("Récap ").Cells(i, 4)
            K = K + 1
            'Sheets("feuil2").Range("c27") = i
            U = (i * 100) / NbLgne
           GL.ProB1 = U ' ICI le PROGRESSBAR
            LabPRB.Width = U ' ICI LE LABEL
        End If
        GL.ComptLigne = K
    Next i
    GL.TdéBit.Value = DéBit
    GL.TdéBit.Value = Format(GL.TCit.Value, "#,##0.00")
    GL.TcréDit.Value = CréDit
    GL.TcréDit.Value = Format(GL.TDit.Value, "#,##0.00")
    GL.TSolDe.Value = CréDit - DéBit
    GL.TSolDe.Value = Format(GL.TlDe.Value, "#,##0.00")
    GL.ProB1.Visible = False
    GL.Image1.Visible = False
    GL.ListBox1.ColumnWidths = "50;55;60;110;170;150;30;55;55;80"
     
    End Sub
    Je vs montre ce code juste pour mon problème de label mais les critiques sur celui-ci sont les bienvenu!

    Tous ce code pour dire que le label ne progresse pas !!!! Sauf lorsqu'il à fini sa recherche, par contre le progressbar fonctionne très bien !!

    avez vous une solution !

    Merci

    jijie

  2. #2
    Expert confirmé
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Par défaut
    Salut, voir avec Repaint de l'UserForm ou alors nettement plus léger en codage via
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Application.StatusBar =
    ou l'on fera apparaitre le décompte d'une boucle.

  3. #3
    Membre chevronné
    Profil pro
    Inscrit en
    Novembre 2007
    Messages
    473
    Détails du profil
    Informations personnelles :
    Localisation : France, Vendée (Pays de la Loire)

    Informations forums :
    Inscription : Novembre 2007
    Messages : 473
    Par défaut
    Merci Kiki !

    OK plus léger ! mais comment ?

    jijie

  4. #4
    Expert confirmé
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Par défaut
    Re, du style
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
     
        For i = 1 To Nb
            '.....
            Application.StatusBar = i & " / " & Nb
        Next i

  5. #5
    Membre chevronné
    Profil pro
    Inscrit en
    Novembre 2007
    Messages
    473
    Détails du profil
    Informations personnelles :
    Localisation : France, Vendée (Pays de la Loire)

    Informations forums :
    Inscription : Novembre 2007
    Messages : 473
    Par défaut
    re salut Kiki ,

    oui ça fonctionne ! mais le souci est que mon USER était en plein écran, et je ne voyais pas la barre !

    Sinon ça fonctionne! Malgré que ça ne me satisfait pas !

    Si il n'y a pas d'autre solution!? je continu à chercher !

    merci pour ton aide

  6. #6
    Expert confirmé
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Par défaut
    Re, as-tu testé, comme suggéré dans Post# 2, avec

  7. #7
    Membre chevronné
    Homme Profil pro
    Inscrit en
    Juin 2011
    Messages
    181
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Secteur : Industrie

    Informations forums :
    Inscription : Juin 2011
    Messages : 181
    Par défaut
    Bonjour à tous,

    Avez-vous essayé la 1ère solution proposée par kiki, à savoir l'instruction "Repaint".

    Il suffirait donc d'écrire juste après l'instruction affectant une nouvelle largeur au label :
    En remplaçant "UserForm" par son Name.

    Cordialement.

  8. #8
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut heu
    bonjour

    en fait il faut que tu fasse un petit calcul intelligent et dynamique

    tu a dans ton usf un label qui doit grandir (en largeur ) en fonction de l'avancement de la boucle avec "i"
    problème si ta boucle fait 300 lignes ton label va faire a la fin 300 certainement plus grand que le userform et c'est pas bon



    en fait il faut


    déterminer le maximum de largeur du label par rapport a ton usf
    et quand tu a déterminer le nombre de lignes avec
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    NbLgne = Sheets("Récap ").Range("a65000").End(xlUp).Row
    tu fait nbligne/largeurmaximum du label
    tu te retrouve avec un nombre que l'on va affiler a une variable "avancement " donc de type long
    et quand ta boucle incrémente "i" tu fait me.LabPRB.Width =(i/avancement)
    ainsi ton label va s'agrandir en fonction de l'avancement et proportionnellement de la tache qu'il reste a faire

    enfin:
    a supposer que ton la bel par exemple mesure 200 quand la sub est terminer

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    Sub ReCherche_Ecritures()
    Dim DéBit, CréDit, SolDE As String,avancement as long
        DéBit = 0
        CréDit = 0
        SolDE = 0
        GL.ProB1 = 0
        LabPRB.Width = 0 ' label de progressbar
        GL.ProB1.Visible = True
        GL.Image1.Visible = True
     
     Dim NbLgne As Variant
        Dim i, j, Y As Integer
        Dim K, P
        Dim TesteR, Teste2 As Boolean
        Dim U As Byte
        GL.ListBox1.Clear
     avancement=nbligne/200
        NbLgne = Sheets("Récap ").Range("a65000").End(xlUp).Row
        'Sheets("feuil2").Range("b27") = NbLgne
     
    For i = 2 To NbLgne + 1
      'si la sub se trouve dans le userform    
     LabPRB.Width = ((i-1)/avancement*)'tout simplement
    'si la sub ne se trouve pas dans le userform
    ' on regarde pour les analyt
     TesteR = False
     If GL.ToUs = True Then
      TesteR = True
      GoTo fin1
      End If
     
     
     
         For Y = 0 To GL.ListBox3.ListCount - 1
     
            If Val(GL.ComptAnal.Value) = 0 And GL.TousAnal.Caption = "Sans analyt." And GL.ToUs = False Then
     
     
            If Cells(i, 5) = "" Then TesteR = True             Exit For
             End If
     
     
            If Val(GL.ComptAnal.Value) > 0 Then
     
            If GL.ListBox3.Selected(Y) = False Then TesteR = False
            If GL.ListBox3.Selected(Y) = True And Cells(i, 5) Like GL.ListBox3.List(Y) Then
                TesteR = True
                Exit For
            End If
     
     
     
            End If
          Next Y
    fin1:
     
     
          If Val(GL.comp.Value) > 0 Then
            For j = 0 To GL.ListBox2.ListCount - 1
            Teste2 = False
            If Cells(i, 9) = GL.ListBox2.List(j) Then
                Teste2 = True
     
                Exit For
                End If
     
              Next j
          End If
     
          If Val(GL.comp.Value) = 0 Then
            Teste2 = False
            If Cells(i, 9) = GL.ComboBox6.Value Then Teste2 = True
          End If
          If GL.ComboBox6.Text = "" Then Teste2 = True
     
    If Cells(i, 10) <> "" And Cells(i, 10) <> 0 And TesteR = True And Teste2 = True _
          And Cells(i, 9) Like UCase(GL.Tst1.Text) & "*" _
          And Cells(i, 1) Like UCase(GL.Tst3.Text) & "*" _
          And Cells(i, 12) Like UCase(GL.Tst4.Text) & "*" _
          And Cells(i, 6) Like "*" & UCase(GL.Tst2.Text) & "*" Then
           GL.ListBox1.AddItem
           GL.ListBox1.List(K, 0) = Sheets("Récap ").Cells(i, 2)
           GL.ListBox1.List(K, 1) = "| " & Sheets("Récap ").Cells(i, 3)
           GL.ListBox1.List(K, 2) = "| " & Sheets("Récap ").Cells(i, 5)
           GL.ListBox1.List(K, 3) = "| " & Sheets("Récap ").Cells(i, 6)
           GL.ListBox1.List(K, 4) = "| " & Sheets("Récap ").Cells(i, 7)
           GL.ListBox1.List(K, 5) = "| " & Sheets("Récap ").Cells(i, 9)
           GL.ListBox1.List(K, 6) = "| " & Sheets("Récap ").Cells(i, 8)
           GL.ListBox1.List(K, 7) = "| " & Sheets("Récap ").Cells(i, 30)
            DéBit = DéBit + Sheets("Récap ").Cells(i, 30)
           GL.ListBox1.List(K, 8) = "| " & Sheets("Récap ").Cells(i, 29)
            CréDit = CréDit + Sheets("Récap ").Cells(i, 29)
           GL.ListBox1.List(K, 9) = "| " & Sheets("Récap ").Cells(i, 4)
            K = K + 1
            'Sheets("feuil2").Range("c27") = i
     
        End If
        GL.ComptLigne = K
    Next i
    GL.TdéBit.Value = DéBit
    GL.TdéBit.Value = Format(GL.TCit.Value, "#,##0.00")
    GL.TcréDit.Value = CréDit
    GL.TcréDit.Value = Format(GL.TDit.Value, "#,##0.00")
    GL.TSolDe.Value = CréDit - DéBit
    GL.TSolDe.Value = Format(GL.TlDe.Value, "#,##0.00")
    GL.ProB1.Visible = False
    GL.Image1.Visible = False
    GL.ListBox1.ColumnWidths = "50;55;60;110;170;150;30;55;55;80"
     
    End Sub

    je n'ai pas regardé le reste du code en considerant qui fonctionne

    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  9. #9
    Membre chevronné
    Profil pro
    Inscrit en
    Novembre 2007
    Messages
    473
    Détails du profil
    Informations personnelles :
    Localisation : France, Vendée (Pays de la Loire)

    Informations forums :
    Inscription : Novembre 2007
    Messages : 473
    Par défaut
    Re slt à vous Kiki, Hoppopop et Patrick !

    En tout cas aujourd'hui je pourrais dire que j'ai appris plusieurs choses !

    Après avoir lu vos post, et après un bon repas me revoilà au travail et en 2 tours j'ai complété mon code comme vous me l'avez dit ! Dont en voici un bout sur le sujet :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    For i = 2 To NbLgne + 1
    LabPRB.Width = ((i - 1) * 200 / NbLgne) 'tout simplement
    GL.Repaint
    ds ce cas j'ai donné une longueur de 200 pour le label

    Sur le fichier que j'utilise actuellement, il y a environ 2000 lignes ( il peut arriver à 5 fois plus), si je charges toutes les lignes, donc tous les filtres à "true"! je ne sais pas si un de vous à essayer mais là, on se croirais en DISCOTHÈQUE !!!!!

    La Listbox recevant les données fait plus de la moitié de l'écran, et je ne vous raconte pas les scintillements de celui-ci ( à essayer en pleine nuit !). De plus il lui faut beaucoup plus de temps pour se réaliser au complet. Mais bon ça fonctionne très bien et comme je le disais j'ai découvert : Repaint et Application.StatusBar je considère donc que c'est une bonne soirée car je suis certain que cela va servir d'autre fois et peut-être au forum aussi ! Ce système de progressbar par un label pourrais donc être utilisé mais il ne faut pas d'autre chose à l'écran qui soit en action (ds mon cas comme le listbox) et sinon faire progresser la barre en pas de 5 voir 10 (.width) serait suffisant!

    Pour finir je pense que je vais utilisé cette formule certe moins bien que le progressbar et label mais bon!

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    GL.Caption = " Vous avez " & i & " lignes de contrôlées sur " & NbLgne & " lignes totales !"
    et lorsque la boucle est terminée :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    GL.Caption = " Vos opérations selon votre filtre sont téléchargées à 100 % ! Vous avez " & K & " lignes filtrées ! "
    L'avantage ( DANS MON CAS !) est que nous n'avons pas besoin de .Repaint et surtout que le code est beaucoup plus rapide, car avec .caption l'utilisateur voie la progression de sa demande.

    Voilà, j'attends vos remarques, et comme dit Patrick

    au plaisir !

    jijie

  10. #10
    Expert confirmé
    Avatar de fring
    Homme Profil pro
    Engineering
    Inscrit en
    Février 2008
    Messages
    3 900
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 62
    Localisation : Belgique

    Informations professionnelles :
    Activité : Engineering

    Informations forums :
    Inscription : Février 2008
    Messages : 3 900
    Par défaut
    Bonjour,

    Teste le petit fichier ci-joint, l'astuce est de mettre le style de texte du Label en Wingdings.
    Fichiers attachés Fichiers attachés

  11. #11
    Expert confirmé
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Par défaut
    Salut, faire une recherche sur john walkenbach

    Dans le même genre que celui de Fred

    Un UserForm avec un Frame et un Label
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    Option Explicit
     
    Private Sub UserForm_Activate()
    Dim Pourcentage As Single
        Pourcentage = 0
        MAJ Pourcentage
        Lancement
    End Sub
    Dans un module standard
    Affecter un bouton à la procédure Go
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    Option Explicit
     
    Sub Go()
        UserForm1.Show
    End Sub
     
    Sub MAJ(Pourcentage)
        With UserForm1
            .Frame1.Caption = Format(Pourcentage, "0%")
            .Label1.Width = Pourcentage * (.Frame1.Width - 5)
            .Repaint
        End With
    End Sub
     
    Sub Lancement()
    Dim Fin As Long, i As Long
    Dim Pourcentage As Single
     
        Fin = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
     
        For i = 1 To Fin
            Pourcentage = i / Fin
            MAJ Pourcentage
        Next i
     
        UserForm1.Hide
    End Sub

  12. #12
    Membre chevronné
    Profil pro
    Inscrit en
    Novembre 2007
    Messages
    473
    Détails du profil
    Informations personnelles :
    Localisation : France, Vendée (Pays de la Loire)

    Informations forums :
    Inscription : Novembre 2007
    Messages : 473
    Par défaut
    Oulala !!

    Bon ça c'est du balaise! Bon je comprend mieux! Pour le moment je suis sur la solution de Fred! et la question est:

    Ds mon User j'ai une variable Nombre de Ligne "NbLgne" et une autre i (pour ma boucle) Alors comment je dois les donner à ton module "Test"?

    Il faut peut-être que ds mon code j'affecte ces variable à des cellules pour que ton Test les récupère ? Mais comment faire tourner ta boucle?

    à vous lire!!

    jijie

    Salut à vous,

    Pour le moment voila ce que j'ai fait! Voici la fin de la boucle

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    GL.ListBox1.List(K, 9) = "| " & Sheets("Récap ").Cells(i, 4)
            K = K + 1
            w = NbLgne / 26 '<-- 26 = nombre de caractères max du label
            x = w
     
     
     
            If i > x Then UserBar.Label1.Caption = UserBar.Label1.Caption & "n": x = x + w: UserBar.Repaint
     
     
     
     
        End If
     
    Next i
    UserBar.Caption = "Opération terminée avec succès"
    Application.Wait Now + TimeValue("00:00:02")
    Unload UserBar
    ...........
    Donc l'User s'ouvre bien, par contre il défile plus vite que la réalité?

    Pourtant Nblgne est bien divisé par 26 et i devrait bien se déclencher tous les 26 ?

    Voila pour le moment !

    jijie

    bon pour le dernier post je suis désolé !

    Avant ma boucle :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
     UserBar.Show 0
     w = NbLgne / 26 '<-- 26 = nombre de caractères max du label
     x = w
     
    For i = 2 To NbLgne + 1
    ......
    et pendant :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    GL.ListBox1.List(K, 9) = "| " & Sheets("Récap ").Cells(i, 4)
            K = K + 1
     
     
            If i > x Then UserBar.Label1.Caption = UserBar.Label1.Caption & "n": x = x + w: UserBar.Repaint
     
     
     
     
        End If
     
    Next i
    UserBar.Caption = "Opération terminée avec succès"
    Application.Wait Now + TimeValue("00:00:02")
    Unload UserBar
    ...........
    Tout compte fait en cherchant on trouve!

    Donc merci à vous tous, ça fonctionne super bien! et ça ne ralenti rien !!

    jijie

  13. #13
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re et re et encore re
    bonjour

    en fait si tu veux adapter le module de fring tu devrais l'utiliser un peu comme ceci
    la mecanique de la boucle ressemble plus a la tienne

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    Sub test()
    Dim i As Long, x As Long, y As Long, NbLigne As Long
     
     
    NbLigne = Range("a" & Rows.Count).End(xlUp).Row
    y = NbLigne / 26 '<-- 26 = nombre de caractères max du label
    'donc y deviens lenombre qui quand il est atteint te donne 1 cararctere en plus
     
    With UserForm1
        .Show 0
        For i = 1 To NbLigne
            x = x + 1 'ici on incremente x+1 a chaque tour de "i"
            'maintenant si x=y soit une portion on ajoute 1"n"et on remet x a 0
            If x = y Then .Label1.Caption = .Label1.Caption & "n": x = 0 ': .Repaint
        DoEvents 'ici je met un doevents afin de ne pas bleauquer l'application en cas de tres grandes boucles
        Next
        .Caption = "Opération terminée avec succès" 'blablabla ect.....
    End With
     
    Application.Wait Now + TimeValue("00:00:02")
    Unload UserForm1
     
    End Sub
    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  14. #14
    Membre chevronné
    Profil pro
    Inscrit en
    Novembre 2007
    Messages
    473
    Détails du profil
    Informations personnelles :
    Localisation : France, Vendée (Pays de la Loire)

    Informations forums :
    Inscription : Novembre 2007
    Messages : 473
    Par défaut
    Patrick,

    Ok mais je place ou le Test ds la boucle de mon UserGL

    jijie

  15. #15
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re et re et encore re
    rebonjour

    en fait exactement ou moi je l'ai placer dans mon exemple
    juste apres le debut de la boucle

    Attention pas toute la sub mais seulement le label
    sans oublier la petite operation
    si tu n'y arrive pas postele code en etier je te le placerais
    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  16. #16
    Membre chevronné
    Profil pro
    Inscrit en
    Novembre 2007
    Messages
    473
    Détails du profil
    Informations personnelles :
    Localisation : France, Vendée (Pays de la Loire)

    Informations forums :
    Inscription : Novembre 2007
    Messages : 473
    Par défaut
    Re salut Patrick,

    Je ne sais pas comment vous remercier de votre temps passé, mais j'ais encore besoin !

    Donc voici:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    Sub ReCherche_Ecritures()
    Dim DéBit, CréDit, SolDE As String
        DéBit = 0
        CréDit = 0
        SolDE = 0
        TSolDe = "0.00"
        TcréDit = "0.00"
        TdéBit = "0.00"
     
     
     
     Dim NbLgne As Variant
        Dim i, j, Y As Integer
        Dim P, K
        Dim TesteR, Teste2 As Boolean
        Dim x As Long
        Dim v As Long
        Dim w As Long
     
        GL.ListBox1.Clear
        GL.Repaint
        NbLgne = Sheets("Récap_cptes").Range("a65000").End(xlUp).Row
        'Sheets("feuil2").Range("b27") = NbLgne
    Application.Cursor = xlWait ''affiche le sablier
    'Application.Cursor = xlDefault 'remet le curseur par défaut
        ListBox1.Clear
     
     w = NbLgne / 26 '<-- 26 = nombre de caractères max du label
     x = w
    With UserBar
        .Show 0
    For i = 2 To NbLgne + 1
            x = x + 1 'ici on incremente x+1 a chaque tour de "i"
            'maintenant si x=y soit une portion on ajoute 1"n"et on remet x a 0
            If x = w Then .Label1.Caption = .Label1.Caption & "n": x = 0 ': .Repaint
        DoEvents 'ici je met un doevents afin de ne pas bloquer l'application en cas de tres grandes boucle
      ' on regarde pour les analyt
     TesteR = False
     If GL.ToUs = True Then
      TesteR = True
      GoTo fin1
      End If
     
     
     
         For Y = 0 To GL.ListBox3.ListCount - 1
     
            If Val(GL.ComptAnal.Value) = 0 And GL.TousAnal.Caption = "Sans analyt." And GL.ToUs = False Then
     
     
            If Cells(i, 5) = "" Then TesteR = True 'accepte les sans analytiques seulement
                Exit For
             End If
     
     
            If Val(GL.ComptAnal.Value) > 0 Then
     
            If GL.ListBox3.Selected(Y) = False Then TesteR = False
            If GL.ListBox3.Selected(Y) = True And Cells(i, 5) Like GL.ListBox3.List(Y) Then
                TesteR = True
                Exit For
            End If
     
     
     
            End If
          Next Y
    fin1:
     
         ' on regarde les cde 
     
          If Val(GL.comptCpte.Value) > 0 Then
            For j = 0 To GL.ListBox2.ListCount - 1
            Teste2 = False
            If Cells(i, 9) = GL.ListBox2.List(j) Then
                Teste2 = True
     
                Exit For
                End If
     
              Next j
          End If
     
          If Val(GL.comptCpte.Value) = 0 Then
            Teste2 = False
            If Cells(i, 9) = GL.ComboBox6.Value Then Teste2 = True
          End If
          If GL.ComboBox6.Text = "" Then Teste2 = True
     
    If Cells(i, 10) <> "" And Cells(i, 10) <> 0 And TesteR = True And Teste2 = True _
          And Cells(i, 9) Like UCase(GL.Tst1.Text) & "*" _
          And Cells(i, 1) Like UCase(GL.Tst3.Text) & "*" _
          And Cells(i, 12) Like UCase(GL.Tst4.Text) & "*" _
          And Cells(i, 6) Like "*" & UCase(GL.Tst2.Text) & "*" Then
           GL.ListBox1.AddItem
           GL.ListBox1.List(K, 0) = Sheets("Récap_cptes").Cells(i, 2)
           GL.ListBox1.List(K, 1) = "| " & Sheets("Récap_cptes").Cells(i, 3)
           GL.ListBox1.List(K, 2) = "| " & Sheets("Récap_cptes").Cells(i, 5)
           GL.ListBox1.List(K, 3) = "| " & Sheets("Récap_cptes").Cells(i, 6)
           GL.ListBox1.List(K, 4) = "| " & Sheets("Récap_cptes").Cells(i, 7)
           GL.ListBox1.List(K, 5) = "| " & Sheets("Récap_cptes").Cells(i, 9)
           GL.ListBox1.List(K, 6) = "| " & Sheets("Récap_cptes").Cells(i, 8)
           GL.ListBox1.List(K, 7) = "| " & Sheets("Récap_cptes").Cells(i, 30)
            DéBit = DéBit + Sheets("Récap_cptes").Cells(i, 30)
           GL.ListBox1.List(K, 8) = "| " & Sheets("Récap_cptes").Cells(i, 29)
            CréDit = CréDit + Sheets("Récap_cptes").Cells(i, 29)
           GL.ListBox1.List(K, 9) = "| " & Sheets("Récap_cptes").Cells(i, 4)
            K = K + 1
     
     
     
     
     
            'If i > x Then UserBar.Label1.Caption = UserBar.Label1.Caption & "n": x = x + w: UserBar.Repaint
     
     
     
     
        End If
     
    Next i
          .Caption = "Opération terminée avec succès" 'blablabla ect.....
    End With
    UserBar.Caption = "Opération terminée avec succès"
    Application.Wait Now + TimeValue("00:00:02")
    Unload UserBar
    GL.TdéBit.Value = DéBit
    GL.TdéBit.Value = Format(GL.TdéBit.Value, "#,##0.00")
    GL.TcréDit.Value = CréDit
    GL.TcréDit.Value = Format(GL.TcréDit.Value, "#,##0.00")
    GL.TSolDe.Value = CréDit - DéBit
    GL.TSolDe.Value = Format(GL.TSolDe.Value, "#,##0.00")
     
    GL.ListBox1.ColumnWidths = "50;55;60;110;170;150;30;55;55;80"
    GL.Caption = "Comptes réalisés de l'exercice --> Vos opérations selon votre filtre sont téléchargées à 100 % ! Vous avez " & K & " lignes filtrées ! "
     
    Application.Cursor = xlDefault 'remet le curseur par défaut
    End Sub
    Donc mon souci est que l'userbar s'affiche mais le label ne donne rien même si je réactive le .Repaint de celui-ci.

    Par contre chose bizarre je voie la Listbox se remplir comme-ci j'avais un .Repaint sur l'User "GL" ?

    Et ds l'ensemble le code est un peu moins rapide!!

    donc au plaisir également !

    jijie

  17. #17
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re et encore re et rere
    re bonjour

    bon je vois que tu a changé le nom de ton userform déjà
    ensuite le nom du label et bien Label1 sinon ça ne peut pas marcher

    on t'a donné plusieurs exemples mais en aucun cas du copier coller
    ensuite juste avant la boucle tu dis x=w c'est pas bon ça c'est la boucle qui s'en charge alors tu m'enlève ça

    ensuite je vois "If GL.ListBox3" etc.... donc on est sur un autre userform nommer "GL" que celui de la barre d'avancement

    enfin tu t'emmêle les pinceaux
    bon puisque maintenant la barre est dans un autre userform "UserBar""
    il faut absolument que tout les userforms soit en "show 0"

    sinon la modification ne marchera pas puis que le focus est sur un autre userform

    déjà dans les propriétés de "GL" met le modal a "FALSE"

    allez on est bientôt arrivé
    peu être avant 26
    allez revoit ca deja et reviens

    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  18. #18
    Membre chevronné
    Profil pro
    Inscrit en
    Novembre 2007
    Messages
    473
    Détails du profil
    Informations personnelles :
    Localisation : France, Vendée (Pays de la Loire)

    Informations forums :
    Inscription : Novembre 2007
    Messages : 473
    Par défaut
    ReReRe slt Patrick!

    Je pensais bien vous avoir dit que j'avais 2 user mais bon et je les avaient bien mis en modal false mais pour x=w ça non !

    Donc maintenant ça fonctionne ! mais ça allonge le temps par rapport à la version que j'avais faite précédemment ! Je pense qu'il faudrait que la listbox de l'USER "GL" se remplisse qu'au dernier moment. Ds ma version précédente seul l'user "UserBar" était en action!

    Je ne sais pas trop comment expliquer, mais il me semble que l'User "GL" à la fonction de .Repaint à chaque passage du " i "!

    Je ne suis pas certain de me faire comprendre?

    Donc voici ce que j'ai fait:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    w = NbLgne / 26 '<-- 26 = nombre de caractères max du label
     
    With UserBar
        .Show 0
    For i = 2 To NbLgne + 1
            x = x + 1 'ici on incremente x+1 a chaque tour de "i"
            'maintenant si x=y soit une portion on ajoute 1"n"et on remet x a 0
            If x = w Then .Label1.Caption = .Label1.Caption & "n": x = 0: DoEvents ': .Repaint
        'DoEvents 'ici je met un doevents afin de ne pas bloquer l'application en cas de tres grandes boucle
    J'ai modifié pour que DoEvents soit dans l'Userbar! et la c'est bcp plus rapide !

    Sinon il est possible de :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
     w = NbLgne / 26 '<-- 26 = nombre de caractères max du label
     
    With UserBar
        .Show 0
    For i = 2 To NbLgne + 1
            x = x + 1 'ici on incremente x+1 a chaque tour de "i"
            'maintenant si x=y soit une portion on ajoute 1"n"et on remet x a 0
            If x = w Then .Label1.Caption = .Label1.Caption & "n": x = 0: .Repaint
        'DoEvents 'ici je met un doevents afin de ne pas bloquer l'application en cas de tres grandes boucle
    Là je mets .Repaint sur Userbar! et ça marche très bien aussi!!

    q'en penses-tu?

    jijie

  19. #19
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut re
    les deux solutions fonctionnent parfaitement

    quand aux version précèdentes plus rapides peut etre parceque tu travaillais sur la caption de l'usf certainement

    apartir du moment ou tu utilise un control activex tu mange forcement de la resource cpu


    on est arrivé voila heu.....t'acompter jusqua 26 au moins ihihihihi

    n'oublie pas le resolu et de voter pouce up ou pouce downselon toàn appreciation sur les reponses que tu a recu des participants de ce post

    pour ma part je metrais un vote a fring il arrive toujours a point nommer celui la
    au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  20. #20
    Membre chevronné
    Profil pro
    Inscrit en
    Novembre 2007
    Messages
    473
    Détails du profil
    Informations personnelles :
    Localisation : France, Vendée (Pays de la Loire)

    Informations forums :
    Inscription : Novembre 2007
    Messages : 473
    Par défaut
    Oui Patrick!

    Je ne sais pas trop pour qui ne pas voter car tout le monde à ds points!! Mais c'est vrai que la version de Fring m'a tout de suite plu !



    un grand merci à vous tous et...

    Au plaisir!

    Jijie

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 5
    Dernier message: 02/12/2014, 11h58
  2. Remplacer null par...
    Par HichamK dans le forum Oracle
    Réponses: 4
    Dernier message: 17/01/2006, 13h56
  3. Réponses: 2
    Dernier message: 14/11/2005, 13h33
  4. [Configuration] remplacement des é par des i
    Par illegalsene dans le forum EDI, CMS, Outils, Scripts et API
    Réponses: 2
    Dernier message: 18/10/2005, 16h37
  5. [ASP] include remplacer chemin par variable
    Par damn dans le forum ASP
    Réponses: 3
    Dernier message: 01/10/2004, 15h27

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo