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

Lone-wolf · 8 Janvier 2017

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.

Calvus · 8 Janvier 2017

Bonjour Lonewolf, le forum,

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

A+

Lone-wolf · 8 Janvier 2017

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 · 8 Janvier 2017

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 · 8 Janvier 2017

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

Lone-wolf · 9 Janvier 2017

Bonjour le Forum

Toujours personne pour m'aider?

job75 · 10 Janvier 2017

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+

job75 · 10 Janvier 2017

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+

Lone-wolf · 10 Janvier 2017

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 · 10 Janvier 2017

Bonsoir,

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

Lone-wolf · 10 Janvier 2017

ça c'est bien vrai.

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

Lone-wolf

XLDnaute Barbatruc

Pièces jointes

Calvus

XLDnaute Barbatruc

Lone-wolf

XLDnaute Barbatruc

Calvus

XLDnaute Barbatruc

Lone-wolf

XLDnaute Barbatruc

Lone-wolf

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Lone-wolf

XLDnaute Barbatruc

Calvus

XLDnaute Barbatruc

Lone-wolf

XLDnaute Barbatruc

Discussions similaires