XL 2016 Barre de progression

Rabeto

XLDnaute Occasionnel
Bonjour,

Je souhaite ajouter une barre de progression lors de l'exécution de la macro dans ce fichier svp,
En cliquant sur un bouton MAJ la barre s'affiche et la macro s'exécute allant de 0% à 100%

Je n'ai pas pu joindre le fichier car c'est volumineux, voici le code que j'utilise

Sub Traiter()
'
' Macro2 Macro
'

'
Columns("G:J").Select
Selection.ClearContents
Columns("A:A").Select
Selection.Copy
Columns("G:G").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("G:G").EntireColumn.AutoFit
Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=True, Other:=False, OtherChar:= _
" ", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
TrailingMinusNumbers:=True
ActiveWorkbook.Worksheets("Calcul Donnée").AutoFilter.Sort.SortFields.CLEAR
ActiveWorkbook.Worksheets("Calcul Donnée").AutoFilter.Sort.SortFields.Add Key _
:=Range("J1:J50001"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Calcul Donnée").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("Calcul Donnée").AutoFilter.Sort.SortFields.CLEAR
ActiveWorkbook.Worksheets("Calcul Donnée").AutoFilter.Sort.SortFields.Add Key _
:=Range("B1:B50001"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Calcul Donnée").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
Range("H1").Select
ActiveCell.FormulaR1C1 = "Mois"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Année"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Heure"
Columns("F:F").Select
Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=True, Other:=False, OtherChar:= _
" ", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Range("A1").Select
End With
End Sub



merci
 
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Rabeto,
Une solution très légère et très simple est d'utiliser le StatusBar. C'est très souvent suffisant s'il s'agit de suivre une progression.
 

Discussions similaires

Réponses
11
Affichages
397
Réponses
3
Affichages
550

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T