Marquer l'affichage pendant le travail

pascal35135

XLDnaute Nouveau
Bonsoir à tous,
J'ai fait un fichier qui récupère une feuille identifier dans plusieurs centaines de classeurs et fabrique un onglet à chaque fois.
Tout fonctionne très bien.
Serait il possible de masquer l'ouverture des fichiers en traitement?
Est il possible d'évaluer le temps de traitement et d'afficher par exemple un sablier?
Le traitement est parfois très long (30 minutes) comment peut on accélérer les opérations, ouverture, lecture, copie, collage dans un nouvelle onglet?

Merci pour votre aide
Pascal
 

job75

XLDnaute Barbatruc
Re : Marquer l'affichage pendant le travail

Bonsoir,

Serait il possible de masquer l'ouverture des fichiers en traitement?

C'est indispensable, utiliser Application.ScreenUpdating = False

Et ça ira bien plus vite.

Est il possible d'évaluer le temps de traitement et d'afficher par exemple un sablier?

S'il n'y a qu'une seule feuille dans chaque fichier, la durée de son traitement doit être à peu près proportionnelle à sont poids en Ko.

On peut alors calculer au début le nombre total de Ko à traiter et utiliser une progress bar.

Le traitement est parfois très long (30 minutes) comment peut on accélérer les opérations, ouverture, lecture, copie, collage dans un nouvelle onglet?

Il faudrait voir votre macro et quelques fichiers significatifs.

En tout état de cause évitez les Select et les Activate.

A+
 

eriiic

XLDnaute Barbatruc
Re : Marquer l'affichage pendant le travail

Bonsoir,

Est il possible d'évaluer le temps de traitement et d'afficher par exemple un sablier?
Tu pourrais afficher dans la barre de message en bas où tu en es :
Code:
statusBarInitial = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Fichier " & numF & " sur " & totF
'.....
Application.StatusBar = ""
Application.DisplayStatusBar = statusBarInitial
Au moins tu vois qu'il n'est pas planté.. Eventuellement ajouter une estimation du temps restant en fonction du temps écoulé et de l'avancement.

eric
 

pascal35135

XLDnaute Nouveau
Re : Marquer l'affichage pendant le travail

Bonsoir et merci pour vos pistes,
L’extraction de la feuille a traiter fait partie d'un classeurs d'une vingtaine de feuilles.
Merci pour votre aide

Si dessous le script de ma macro.
*****************
Private Sub Recup()
' Récuprération de la feuille stats
'

'Empeche l'affichage du travail
Application.ScreenUpdating = False

Dim Fichier() As String
Dim Lecture As String, Chemin As String
Dim Compte As Long
Dim NomFichier As Variant
Dim Onglet As Worksheet
Dim Nom As String, Retour As String
Dim Ligne As Long
Dim Trouve As Range
Dim version As String
' Boucle de lecture des fichiers dans un répertoire
Chemin = Range("F11")
Lecture = Dir(Chemin & "*.xls*")
Compte = 0

'Récupération de la liste des fichiers du dossier
Do
ReDim Preserve Fichier(Compte)
Fichier(UBound(Fichier)) = Lecture
Lecture = Dir
Compte = Compte + 1
Loop Until Lecture = ""

'Analyse et recopie éventuelle des onglets Protocoles
For Each NomFichier In Fichier
Workbooks.Open Filename:=Chemin & NomFichier, ReadOnly:=True
For Each Onglet In Workbooks(NomFichier).Worksheets
If Onglet.Name = "Stats_IPR" Then
Nom = Onglet.Range("A7").Value
version = Onglet.Range("A5").Value
Set Trouve = ThisWorkbook.Sheets("Reception").Range("A:A").Find(Nom, lookat:=xlWhole)
If Not Trouve Is Nothing Then
Retour = MsgBox("Nom figurant déjà dans la liste réception, voulez vous continuer", vbYesNo, "ALERTE DOUBLONS")
If Retour = vbYes Then
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(Nom).Delete
Application.DisplayAlerts = True
GoTo Reprise
End If
Else
Reprise:
Onglet.Copy After:=ThisWorkbook.Worksheets("Reception")
ThisWorkbook.Worksheets("Stats_IPR").Name = Nom
Ligne = ThisWorkbook.Sheets("Reception").Range("A" & Rows.Count).End(xlUp).Row + 1
ThisWorkbook.Sheets("Reception").Range("A" & Ligne) = Nom

ThisWorkbook.Sheets("Reception").Range("C" & Ligne) = version
'
' Place le lien correspondant pour ouvrir la feuille du meme nom
ActiveSheet.Hyperlinks.Add Anchor:=Sheets("Reception").Range("A" & Ligne), Address:="", SubAddress:=Nom & "!A1", TextToDisplay:=Nom


ThisWorkbook.Sheets("Reception").Range("B" & Ligne) = Format(Date, "dd-mm-yyyy")
Exit For
End If
End If
Next
Workbooks(NomFichier).Close False
Next

' lancer macro ClasserOnglets
' Run "ClasserOnglets"
' retour sur page reception
Sheets("Reception").Select
Range("A1").Select
End Sub