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 !