Barre d'avancement dans une macro

31toto

XLDnaute Junior
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 :
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 Sub

et 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à....

Code:
'############################################################
'#######  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 Sub

mais 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 :) et bonne journé à vous !
 

Discussions similaires

Réponses
0
Affichages
177