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

Statistiques des forums

Discussions
313 264
Messages
2 096 657
Membres
106 701
dernier inscrit
KOFFI