Afficher pourcentage progression USERFORM

helias jeremy à dit:

Bonjour à tous, je suis nouveau sur le forum !
J'ai une macro "gomme" qui efface l'ensemble des onglets du fichier.

Il faudrait pouvoir mettre un compteur à chaque call exécuté, quelque chose dans ce genre là.

Cliquez pour agrandir...

helias jeremy à dit:

Bonjour à tous, je suis nouveau sur le forum !
Durant le processus, j'ai mis un userform "veuillez patienter effacement en cours..." pour faire attendre l'utilisateur.
Ex : 22% avancement

Il faudrait pouvoir mettre un compteur à chaque call exécuté, quelque chose dans ce genre là.

Cliquez pour agrandir...

helias jeremy à dit:

Bonjour à tous, je suis nouveau sur le forum !

J'ai une question concernant un fichier Excel (non sans blagues !)

J'ai une macro "gomme" qui efface l'ensemble des onglets du fichier.
Durant le processus, j'ai mis un userform "veuillez patienter effacement en cours..." pour faire attendre l'utilisateur.
Seulement j'aimerais y apporter plus de détails avec l'évolution en pourcentage de l'effacement.
Ex : 22% avancement
Mais c'est là que je sèche...

Dans la structure globale du fichier, j'ai une macro effacer par onglet (effacer onglet 1, effacer onglet 2...) et dans la macro "gomme" je call toutes les macro effacer.

Je vous joint un exemple (la macro gomme se situe sur l'onglet fournisseurs en haut)

Il faudrait pouvoir mettre un compteur à chaque call exécuté, quelque chose dans ce genre là.

Si une âme charitable pouvait m'aider ce serait sympa, merci d'avance.

Cliquez pour agrandir...

helias jeremy à dit:

ça marche parfaitement !!

J'ai ajouté une textbox en dessous et j'ai donc adapté userform1.textbox1.value = "avancement : xx %"
Merci beaucoup !
Et concernant les lenteurs à l'enregistrement du fichier (ou même à l'ouverture du fichier) est ce que je peux faire quelque chose?

Cliquez pour agrandir...

helias jeremy à dit:

ça marche parfaitement !!

J'ai ajouté une textbox en dessous et j'ai donc adapté userform1.textbox1.value = "avancement : xx %"
Merci beaucoup !
Et concernant les lenteurs à l'enregistrement du fichier (ou même à l'ouverture du fichier) est ce que je peux faire quelque chose?

Cliquez pour agrandir...

Sub Nettoie()
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String
Dim Avant As Double, plage As Range
Dim MemVisible
On Error Resume Next
Calc = Application.Calculation ' ---- mémorisation de l'état de recalcul
'------------------------------------------------------------
MsgBox "Pour le classeur actif : " _
& Chr(10) & ActiveWorkbook.FullName _
& Chr(10) & "dans chaque feuille de calcul" _
& Chr(10) & "recherche la zone contenant des données," _
& Chr(10) & "réinitialise la dernière cellule utilisée" _
& Chr(10) & "et optimise la taille du fichier Excel", _
vbInformation, _
"d'après LL par GeeDee@m6net.fr"
'-------------------------------------------------------------
MsgBox "Taille initiale de ce classeur en octets" _
& Chr(10) & FileLen(ActiveWorkbook.FullName), _
vbInformation, ActiveWorkbook.FullName
'------------------------------------------------------------
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours..."
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = True
End With
'-------------------- le traitement
For Each Sht In Worksheets
' Si la feuille est masquée
MemVisible = Sht.Visible
If Sht.Visible <> xlSheetVisible Then Sht.Visible = xlSheetVisible
'
Avant = Sht.UsedRange.Cells.Count
Application.StatusBar = Sht.Name & "-" & Sht.UsedRange.Address
'-------------------Traitement de la zone trouvée
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
'----------------Suppression des lignes inutilisées
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Delete
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2)
'----------------Suppression des colonnes inutilisées
If Not DCell Is Nothing Then Sht.Range(DCell, Sht.[IV1]).EntireColumn.Delete
End If
Rien = Sht.UsedRange.Address
End If
'ActiveWorkbook.Save
'---------------------Message pour la feuille traitée
MsgBox "Nom de la feuille de calcul :" _
& Chr(10) & Sht.Name _
& Chr(10) & Format(Sht.UsedRange.Cells.Count / Avant, "0.00%") _
& " de la taille initiale", _
vbInformation, ActiveWorkbook.FullName
'
Sht.Visible = MemVisible
Next Sht
'--------------------Message fin de traitement
MsgBox "Taille optimisée de ce classeur en octets " & Chr(10) _
  & FileLen(ActiveWorkbook.FullName), vbInformation, _
  ActiveWorkbook.FullNameActive
'--------------------
Application.StatusBar = False
Application.Calculation = Calc
End Sub

La macro vide seulement les données saisies, ce n'est pas pour "tout" supprimer.

Cliquez pour agrandir...