Temps d'attente - Progress bar

Bonjour le forum,

Ci-dessous le code qui s'excécute à l'ouverture de mon application (merci le forum pour l'aide).

Entre les deux call, une bonne vingtaine de secondes s'écoulent car je suis contraint de rappatrier une liste de fichiers (environ 2000) qui change trés souvent.

Je souhaiterais entre les deux call mettre une boite de dialogue avec une progress bar ou quelque chose d'agréable et d'animé pour faire patienter l'utilisateur.

J'ai déjà regardé divers sujets sur le forum mais je n'ai pas trouvé de solutions adaptées.

Merci encore de votre aide.

Private Sub Workbook_Open()

End Sub

Bonjour,

pourrais-tu mettre le code de ta première procédure appelée? (ListeFichiersClichés)

Ceci afin de pouvoir insérer un progressbar dans ce code, en fonction de la boucle principale...

Pas de pb le voici

Sub ListeFichiersClichés()

Dim MyPath$, FName$, Mem$, i

MyPath = "C:\........\.......\..........\"

FName = Dir(MyPath & "*.*")

Sheets("Liste Clichés").Select

Range("A:A").Select

Selection.ClearContents

Range("A2").Select

Do While FName <> ""

[A65536].End(xlUp)(2) = FName

FName = Dir

Loop

Sheets("Masque").Select

End Sub

Bonjour

Le problème réside dans le réglage du Progress Bar (équivalent au temps d'éxécution de la commande, donc, à tester)

Un exemple initié par Felix sur le Forum (ici 2mn)

https://www.excel-pratique.com/~files/doc2/gBnu1Exemple_barre_de_progression.zip

Cordialement

Re-,

avec ce code, il me met 0.08 secondes pour rapatrier 829 fichiers...

Donc une progressbar????

Sub ListeFichiersClichés()
Dim MyPath$, FName$, Mem$, i
t = Timer
MyPath = "C:\....\.....\"
FName = Dir(MyPath & "*.*")
With Sheets("Liste Clichés")
    .Range("A:A").ClearContents
    Do While FName <> ""
        .[A65536].End(xlUp)(2) = FName
        FName = Dir
    Loop
End With
MsgBox Timer - t
End Sub

Dis-moi si tu as à peu près le même résultat, en exécutant uniquement ce code...

Re-,

et ensuite, on va traiter la deuxième procédure...

Joins également le code, afin de l'analyser

ALors voici les résultats.

Dans un fichier nouveau => T = 0,34 pour 1903 fichiers

Dans mon fichier => T = 62,70

Je ne comprends pas car je lui demande de faire ce code dés l'ouverture et ensuite de faire le reste donc il ne devrait pas être perturbé...

Le code du démarrage :

Private Sub Workbook_Open()

Application.ScreenUpdating = False

Sheets("Liste Clichés").Visible = True

Call ListeFichiersClichés

Sheets("Liste Clichés").Visible = False

Call Ouverture

End Sub

Les fichiers vont se coller dans la feuille "Liste clichés"

La procédure Liste Clichés

Sub ListeFichiersClichés()

Dim MyPath$, FName$, Mem$

MyPath = "C:\........\............\........\"

FName = Dir(MyPath & "*.*")

With Sheets("Liste Clichés")

.Range("A:A").ClearContents

Do While FName <> ""

.[A65536].End(xlUp)(2) = FName

FName = Dir

Loop

End With

Sheets("Masque").Select

End Sub

Ensuite j'ai une procédure "ouverture" qui retire les liens hypertexte d'une utilisation antérieure, pusi qui supprime des contenus de cellule et qui ouvre un Formulaire donc rien de transcendant.

Sub Ouverture()

Application.ScreenUpdating = False

Sheets("Données").Select

Range("A11:A65000").Select

Selection.NumberFormat = "@"

Sheets("Masque").Select

Range("D7").Select

Selection.NumberFormat = "@"

Range("D7:H7,A111:AJ117,X29").Select

Selection.ClearContents

Range("A2").Select

Dim H1 As Object

For Each H1 In Cells.Hyperlinks

Cells(H1.Range.Row, H1.Range.Column).Value = ""

Next

Range( _

"Q5:T5,C37:H37,J37:O37,Q37:V37,X37:AC37,AE37:AJ37,M44:O44,M46:O46,AG57:AI57,AG59:AI59,AG71:AI71,AG73:AI73,AG85:AI85,AG87:AI87,AG99:AI99" _

).Select

Selection.ClearContents

UserForm2.Show

Re-,

Pour la différence de temps de traitement, je pense qu'il est dû au recalcul de chaque lien au cours de l'exécution du premier code...

Essaie avec ces codes :

Dans le ThisWorkbook :

Private Sub Workbook_Open()
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
Sheets("Liste Clichés").Visible = True

Call ListeFichiersClichés

Sheets("Liste Clichés").Visible = False

Call Ouverture
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

et dans un module standard :

Sub ListeFichiersClichés()
Dim MyPath$, FName$, Mem$, i
MyPath = "C:\....\.....\"
FName = Dir(MyPath & "*.*")
With Sheets("Liste Clichés")
    Range("A:A").ClearContents
    Do While FName <> ""
        .[A65536].End(xlUp)(2) = FName
        FName = Dir
    Loop
End With
End Sub
Sub Ouverture()
Dim H1 As Hyperlink

With Sheets("Données")
    .Range("A11:A65000").NumberFormat = "@"
End With
With Sheets("Masque")
    .Range("D7").NumberFormat = "@"
    .Range("D7:H7,A111:AJ117,X29").ClearContents
    For Each H1 In .Cells.Hyperlinks
        H1.Range.ClearContents
    Next
    .Range("Q5:T5,C37:H37,J37:O37,Q37:V37,X37:AC37,AE37:AJ37,M44:O44,M46:O46,AG57:AI57,AG59:AI59,AG71:AI71,AG73:AI73,AG85:AI85,AG87:AI87,AG99:AI99").ClearContents
End With
End Sub

et dis si on gagne en temps????

Ca fonctionne impeccable mais il n'accepte plus ces lignes

.Range("A:A").ClearContents

.Range("D7:H7,A111:AJ117,X29").ClearContents

Il me met "Impossible de modifier une cellule fusionnée".

Alors qu'avant la modifiication du code il n'y avait pas de souci...

Re-,

je ne saurai que trop te conseiller d'éviter de fusionner des cellules..

C'est une plaie pour le VBA

Si tu veux avoir le même aspect, tu sélectionnes tes cellules fusionnées, tu dé-fusionnes, puis tu sélectionnes les cellules qui étaient fusionnées (Ex : A1 à D1), Format/Cellule/Alignement/Horizontal : Centrer sur plusieurs colonnes.

Tu gardes ta feuille joulie comme tout, les emm""" en moins....

En fait j'ai scindé l'étape en deux.

Range("Les cellules").select

Selection.clearcontents

Et plus de souci.

Merci beaucoup pour l'aide car les fichiers se chargent en 0,57.

Re-,

Bien content que cela te convienne...

Il est bien souvent plus facile de modifier le code, que de mettre des ProgressBars, ou autres messages d'attente, quoiqu'en disent certains....(mais là, c'est une autre histoire...)

Quelques artifices, comme la mise en manuel du calcul et le non raffraichissement de l'écran peuvent parfois diviser par 10 ou 20 le temps de traitement d'un code.

Bonne soirée

Rechercher des sujets similaires à "temps attente progress bar"