XL 2019 Barre de progression

[BEKA One]

Salut la communauté,
Je viens encore une fois solliciter l'aide du forum. Je précise que je suis un débutant en excel. Et là je suis presque à la fin d'un de mes projets et j'ai besoin d'un gros coup de main.

J'ai élaboré un fichier comportant une bonne dizaine de feuilles qui se remplissent à partir des formulaires. J'ai préparé le fichier pour être réutilisable les années suivantes, du coup j'ai prévu un code de réinitialisation qui permet de vider toutes les feuilles en plus des photos dans les répertoires séparés. Mais vu qu'il y a plusieurs feuilles, le code de la procédure prend du temps pour s'exécuter. C'est là que j'ai pensé y insérer une barre de progression afin d'informer l'utilisateur sur l'état d'avancée de la procédure.

J'ai réussi à trouver sur internet deux (02) modèles de barre de progression qui me vont bien. Mon seul problème c'est que je n'arrive pas à adapter les codes à mon projet. Ce que je souhaite faire, c'est de pouvoir afficher l'état d'avancement de l'exécution du code de suppression des données des feuilles grâce aux barres de progression. J'avoue que je ne comprend rien aux codes trouvés sur le net.

J'ai créé deux (02) fichiers ci-joints avec un exemple de feuille pré remplie avec les barres de progression que je souhaite intégrer à mon projet. Merci d'avance à toutes les personnes qui sont disposées à m'aider dans cette tâche.

PS: Au passage, quelqu'un aurait-il un code qui permettrait de supprimer uniquement des images dont les noms commencent par un préfixe donné (par exemple AGE-000) dans un dossier!

Cordialement!

 

[patricktoulon]

re
non ce qu'il veux faire en fait c'est effacer 14 plage de x lignes x colonnes différentes jusqu’à peut être 100000 lignes sur certains sheets
il a précisé ce point il y a quelques posts déjà

100000 c'est pas le nombre de tours de boucles mais le nombre possible de lignes a effacer

tu peux ajouter 100000 mille elles deviendront pas transparentes

quel intérêt aurait on a effacer 14 plages 100 mille fois ?

je pense que le demandeur a plus besoins qu'on lui explique la mécanique pour faire ce travail
le progress n'est la que pour indication et c'est secondaire

 

[Staple1600]

Bonsoir le fil,

Une idée farfelue vient de m'étreindre
(remplir du vide avec du vide, et parce c'est dans l'air du temps de recycler)

Private Sub RAZ(Adr$)
'Donc je recycle ce que j'avais  pondu en 2018 ;-)
'https://www.excel-downloads.com/threads/exporter-un-classeur.20024896/#post-20187464
Dim arrWSN() As String, i%
ReDim arrWSN(1 To Sheets.Count)
For i = 1 To Worksheets.Count
arrWSN(i) = Sheets(i).Name
Next i
Set Rng = Sheets(1).Range(Adr)
Rng.Clear
Worksheets(arrWSN).FillAcrossSheets Rng
End Sub
Sub test()
RAZ "A1:K150"
RAZ "A1:N575"
RAZ "A1:Q99"
End Sub

Reste à voir ce que cela donne sur le fichier réel.
(J'ai fais le test avec 10 feuilles)

 

[Roland_M]

re

ben c'est certain, j'ai bien compris !
mais c'est lui que j'ai du mal à suivre !? il montre un modèle, je lui fait point barre !
moi aussi je trouvais ça bizarre, le but ne serait pas d'effacer autant de fois ces plages mais le temps pris pour la répétition
je ne cherche plus à comprendre !

 

[Staple1600]

Re, Bonsoir Roland_M

Apparemment, à force de triturer du vide, mon message lui aussi est tomber dans le vide du forum
(cf le message 32)

 

[Roland_M]

re

non, perso j'ai bien vu !
le problème exposé par BEKA n'est pas réalisable tant que l'on a pas un modèle dans les conditions réelles

perso tout ce que je vois c'est un modèle qui boucle pour supprimer X fois les mêmes plages
la 1'fois j'étais surpris, comme tout le monde, mais il a répondu que c'était pour avoir un aperçu du temps nécessaire
mais qu'en réalité il y aurait qq milliers de lignes sur plusieurs feuilles, non représentatif dans sont exemple
mais qu'il ne pouvait pas fournir de classeur les données étant très confidentielles !
donc je vois pas comment on pourrait solutionner sans exemple concret !
je me contente de lui fournir sa barre dans son exemple sans chercher plus loin.

voilà voilà !

 

[patricktoulon]

re
bonsoir Staple160 en voila une idée remplir de vide
bon toujours est il que

effacer 14 plages même très importantes prennent au grand max 1.5 secondes

a tester dans un fichier vierges avec au moins 14 feuilles

'on les rempli dans une plage address aléatoire minimum 400000 lignes et minimum 10  colonnes
Sub test()
    Application.ScreenUpdating = False
    For i = 2 To 14
        x = Round(40000 + (Rnd * 25000))
        c = Round(10 + (Rnd * 5))
        With Sheets(i)
            .Select
            .Range("A1", Cells(x, c)).Value = 1
        End With
    Next
End Sub

'maintenant on les vides
Sub test2()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 1 To 14
txt = txt & "feuille" & i & "  " & Sheets(i).[A1].CurrentRegion.Address & vbCrLf
Sheets(i).[A1].CurrentRegion.ClearContents
Next
Application.Calculation = xlCalculationAutomatic
MsgBox txt & vbCrLf & "terminé"

End Sub

pas besoins de progress

 

[Staple1600]

Re, Bonsoir patricktoulon

Et combien de temps mets mon code pour traiter 14 feuilles ?
Au final, copier une plage vide sur la même plage de cellules mais sur N feuilles, c'est un peu comme les effacer, non ?

PS: Et je plussoie (si j'étais moi) je n'utiliserai point de progressbar

 

[BEKA One]

re
bonsoir Staple160 en voila une idée remplir de vide
bon toujours est il que

effacer 14 plages même très importantes prennent au grand max 1.5 secondes

a tester dans un fichier vierges avec au moins 14 feuilles

'on les rempli dans une plage address aléatoire minimum 400000 lignes et minimum 10  colonnes
Sub test()
    Application.ScreenUpdating = False
    For i = 2 To 14
        x = Round(40000 + (Rnd * 25000))
        c = Round(10 + (Rnd * 5))
        With Sheets(i)
            .Select
            .Range("A1", Cells(x, c)).Value = 1
        End With
    Next
End Sub

'maintenant on les vides
Sub test2()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 1 To 14
txt = txt & "feuille" & i & "  " & Sheets(i).[A1].CurrentRegion.Address & vbCrLf
Sheets(i).[A1].CurrentRegion.ClearContents
Next
Application.Calculation = xlCalculationAutomatic
MsgBox txt & vbCrLf & "terminé"

End Sub

pas besoins de progress

Merci beaucoup Patrick

 

[patricktoulon]

re
Alors beka one c'est plus long que ça chez toi ?

 

[Staple1600]

Bonsoir aussi à toi BEKA One

Apparemment, mon code ne t'a pas fait levé un sourcil...

 

[patricktoulon]

Re, Bonsoir patricktoulon

Et combien de temps mets mon code pour traiter 14 feuilles ?
Au final, copier une plage vide sur la même plage de cellules mais sur N feuilles, c'est un peu comme les effacer, non ?

PS: Et je plussoie (si j'étais moi) je n'utiliserai point de progressbar

re oui sauf que pour le demandeur les plages ne sont pas identiques

oui perso j'aime bien les effets visuels comme un progress working mais pour des jobs sur Access a partir d'excel par exemple qui sont bien plussssssss lourds que 14 plages rikiki dans 14 feuilles
mais l'idée de Roland de longeur fixe dans le statusbar m'a bien plus

 

[Roland_M]

re

j'abandonne car l'ami a du mal à suivre . . .
il n'essaie pas les fichiers joints, on perd son temps !
bonne soirée !

EDIT: par contre ta macro me plait, bien je la garde !

Sub AffProgressStatusBar2(ValEnCours As Variant, ValMaxi As Variant) 'patrick
    Dim A&, Bar$, LongBar&
    LongBar = 120 'long.bar en terme de caractere
    A = ValEnCours / (ValMaxi / LongBar) 'calcul index(situation bar) par rapport à ValEnCours iteré à partir de 1 dans la boucle
    Bar$ = String(A, Chr$(8)) & String(LongBar - A, Chr$(7)) 'creation du string
    Application.StatusBar = " <|" & Bar$ & "|> " & Int((A + 0.1) * 100 / LongBar) & " %/100" '(0.1)évite div.zero
    DoEvents
End Sub

 

[Staple1600]

Re

A ne tester que sur un classeur auquel on ne tient pas

Sub Tabula_Rasa()
Dim i&
On Error Resume Next
For i = 1 To Worksheets.Count
Sheets(i).UsedRange.Value = Empty
Sheets(i).DrawingObjects.Delete
Next i
End Sub

 

[patricktoulon]

re
oui tout simplement

 

[BEKA One]

Bonsoir aussi à toi BEKA One

Apparemment, mon code ne t'a pas fait levé un sourcil...

Navré Staples,

J'étais tellement occupé à tester les codes que m'ont fourni Patrick et Roland!
Je vais essayer le votre et je vous fait un retour!

Sincèrement désolé!