Barre d'avancement dans une macro
t
Bonjour tout le monde !
jaurai besoin de votre aide pour rendre compliqué ma macro ^^
pour que mes reponsable trouve ca serieux
enfait j'ai une macro qui liste des fichiers xls avec lien hypertexte dans une colonne, et à coté le nom de l'onglet. voici le code :
Public Sub test_import_noms_dossiers()
Dim mem1 As Long, mem2 As Long, mem3 As Long, mem4 As Long
'mémoriser/désactiver les options d'excel
mem1 = Application.Calculation: Application.Calculation = xlCalculationManual
mem2 = Application.EnableEvents: Application.EnableEvents = False
mem3 = Application.ScreenUpdating: Application.ScreenUpdating = False
mem4 = Application.DisplayAlerts: Application.DisplayAlerts = False
mem5 = Application.AskToUpdateLinks: Application.AskToUpdateLinks = False
'exécuter la macro
On Error Resume Next
test_import_noms_dossiers_int
On Error GoTo 0
'rétablir les options d'excel
Application.Calculation = mem1
Application.EnableEvents = mem2
Application.ScreenUpdating = mem3
Application.DisplayAlerts = mem4
Application.AskToUpdateLinks = mem5
End Sub
Private Sub test_import_noms_dossiers_int()
Dim i, j, k As Integer
Dim A As String
A = ActiveWorkbook.Name
Range("A6:B5000").Select
Range("B6").Activate
Selection.ClearContents
Range("B1:H2").Select
With Application.FileSearch
' adresse du répertoire
.LookIn = "G:\DIM-DCT-66530\66532\1 - Tech Def"
' type ou nom du fichier
.Filename = "*.xls"
' recherche dans les sous-dossiers
.SearchSubFolders = True
' executer la recherche
.Execute
' insertion dans le classeur excel
j = Range("A6").Row
For i = 1 To .FoundFiles.Count
Cells(j, 1) = .FoundFiles(i)
With ActiveSheet
.Hyperlinks.Add Anchor:=.Cells(j, 1), _
Address:=.Cells(j, 1), _
TextToDisplay:=.Cells(j, 1).Value
.Hyperlinks(i).ScreenTip = " VERS:" & .Cells(i + 5, 1).Value
End With
Workbooks.Open Cells(j, 1).Value, , True
For k = 1 To Sheets.Count
Workbooks(A).Sheets(1).Cells(j, 2).Value = Sheets(k).Name
j = j + 1
Next k
ActiveWorkbook.Close
Next i
End With
End Subet comme j'ai bcp de fichier (elle peut durer jusqu'à 10min...)
j'aimerai rajouter une barre d'avancement (en pourcentage ou autre,...)
j'ai trouvé ce code là....
'############################################################
'####### gestion barre avancement reporting fichiers #######
'############################################################
Sub lance_barre_reporting()
F_BarreAttente.Show
'==== traitement1
F_BarreAttente.Label1.Width = 0
F_BarreAttente.Label2.Width = 0
DoEvents
End Sub
Sub inc_bar_rep(ByVal perce As Double)
'F_BarreAttente.Caption = Left("" & perce, 4) & "%"
F_BarreAttente.Label1.Width = Int(perce * 200)
F_BarreAttente.Label1.Caption = Left("" & (perce * 100), 4) & "%"
DoEvents
End Sub
Sub inc_bar_fich(ByVal perce As Double)
F_BarreAttente.Label2.Width = Int(perce * 200)
F_BarreAttente.Label2.Caption = Left("" & (perce * 100), 4) & "%"
DoEvents
End Sub
Sub decharge_barr()
Unload F_BarreAttente
End Submais je sais pas si il est complet et je sais pas comment l'intergrer..
qu'il prene en compte ma macro pour établir les pourcentages..;
merci d'avance pour votre aide