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 :
	
	
	
	
	
		
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à....
	
	
	
	
	
		
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 !
	
		
			
		
		
	
				
			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 !