XL 2010 [Résolu] Problème d'incrémentation de lignes avec barre de progression

[Lone-wolf]

Bonjour le Forum 🙂

J'ai cette macro

Sub Incremente()
Dim lig As Long, i As Long, nb As Integer, t

    On Error Resume Next
    nb = 1
    With Feuil1
        lig = .Cells(Rows.Count, 1).End(xlUp).Row + 1

        Do While lig < 100
            nb = nb + 1
            .Range(.Cells(lig, 1), .Cells(lig, 7)) = nb
            lig = lig + 1
           t = Timer + 1: Do Until Timer > t: DoEvents: Loop
        Loop
    End With
End Sub

Lors de l'appel du formulaire avec barre de progression, celle-ci s'arrête à la 2ème ligne. J'aimerai que les lignes s'incrémentent en même temps que la barre de progression.

 

[Calvus]

Bonjour Lonewolf, le forum,

Je ne sais pas si cela répondra à ta demande, mais chez moi ton code fonctionne correctement.

A+

 

[Lone-wolf]

Bonjour Calvus 🙂

Que veux tu dire: que les lignes s'incrémentent en même temps que la barre??? 😵

la dernière modification que je viens de faire, incrémente d'abord les lignes; une fois arrivé à la 102ème, c'est la barre qui ce met en route. 🙄 😡

 

[Calvus]

Re, 🙂

Si je me mets en mode pas à pas, c'est effectivement ce qu'il se passe. Sinon, c'est fluide et seule la barre de progression s'affiche et se remplit entièrement.
Je ne sais pas trop quoi te dire, mais comme tu le sais, je suis loin dêtre le plus fort pour pouvoir te répondre ou t'aider. 🙁

 

[Lone-wolf]

Ne t'en fait pas, je comprends parfaitement. J'éspère avoir un coups de main, on verra.

 

[Lone-wolf]

Bonjour le Forum 🙂

Toujours personne pour m'aider? 😳

 

[job75]

Bonjour Lone-wolf, Calvus,

Je me demande bien Lone-wolf d'où tu as pu sortir ces codes improbables !!!

Alors qu'a priori il suffit de ceci :

Sub ShowUserForm()
    UserForm1.LabelProgress.Width = 0
    Application.OnTime 1, "Incremente"
    UserForm1.Show
End Sub

Sub Incremente()
Dim nb As Integer, t
    With Feuil1
        .Range("A2:G" & .Rows.Count) = "" 'RAZ
        For nb = 1 To 100
            .Cells(nb + 1, 1).Resize(, 7) = nb
            UserForm1.LabelProgress.Width = nb / 100 * UserForm1.FrameProgress.Width
            UserForm1.Lb_Prc = nb & "%"
           t = Timer + 0.25: Do Until Timer > t: DoEvents: Loop 'pas de 0,25 seconde
        Next
    End With
    Unload UserForm1
End Sub

Fichier joint.

A+

 

[job75]

Re,

Avec 1000 lignes ça fonctionne aussi bien :

Sub Incremente()
Dim nb As Integer, t
    With Feuil1
        .Range("A2:G" & .Rows.Count) = "" 'RAZ
        For nb = 1 To 1000
            .Cells(nb + 1, 1).Resize(, 7) = nb
            UserForm1.LabelProgress.Width = nb / 1000 * UserForm1.FrameProgress.Width
            UserForm1.Lb_Prc = Int(nb / 10) & "%"
           t = Timer + 0.025: Do Until Timer > t: DoEvents: Loop 'pas de 0,025 seconde
        Next
    End With
    Unload UserForm1
End Sub

Fichier (2).

A+

 

[Lone-wolf]

Bonsoir job 🙂

Nickel ! Comme d'habitude. 😉

Le code je l'ai vu il y a très longtemps sur un site americain(je crois). C'était un tuto. Mais sans l'insertion des lignes.


Merci beaucoup

 

[Calvus]

Bonsoir,

Job ! Notre Sauveur ! 🙂
En tout cas le tien ce soir, Lonewolf 😉

 

[Lone-wolf]

ça c'est bien vrai. 😳🙂