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

Lone-wolf

XLDnaute Barbatruc
Bonjour le Forum :)

J'ai cette macro

VB:
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.
 

Pièces jointes

  • Barre WUp.xlsm
    39.1 KB · Affichages: 58

Lone-wolf

XLDnaute Barbatruc
Bonjour Calvus :)

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

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. :rolleyes: :mad:
 

Calvus

XLDnaute Barbatruc
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. :(
 

job75

XLDnaute Barbatruc
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 :
Code:
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+
 

Pièces jointes

  • Barre WUp(1).xlsm
    37.9 KB · Affichages: 35

job75

XLDnaute Barbatruc
Re,

Avec 1000 lignes ça fonctionne aussi bien :
Code:
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+
 

Pièces jointes

  • Barre WUp(2).xlsm
    37.6 KB · Affichages: 44

Discussions similaires