XL 2016 Barre de progression

[Rabeto]

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

 

[sylvanu]

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.

Insérer un ProgressBar dans le StatusBar

On peut insérer un ProgressBar dans le StatusBar pour éviter l'utilisation d'un useform. C'est une autre méthode simple de voir la progression d'un événement. Le code est très simple à copier dans votre code , et idem pour l'appel de la fonction...

www.excel-downloads.com