Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2021 Accélérer la copie du classeur actif faite par vba

Usine à gaz

XLDnaute Barbatruc
Bonjour à toutes et à tous
Je vous souhaite un beau WE...
et pour ce fil

XL 2021 - Faire une copie de mon classeur quand "Target" change

Bonjour à toutes et à tous :) Mon cher Gérard m'avait donné un code à l'occasion de ce fil : https://excel-downloads.com/threads/enregistrer-sur-le-bureau-chaque-5mn-classeur-actif-sous-son-nom-1.20033906/page-4#posts 2019, Mon besoin était : 1 sauvegarder toutes les 5 minutes qui sont...
excel-downloads.com
Bjr Gérard, Bjr Fipat, Bjr le Fil

Dans ce fil, j'ai choisi le code de Gérard qui fonctionne super bien, Merci Gérard
Merci aussi à Fipat ton code fonctionne aussi et je le garde.

Je reviens en référence au fil ci-dessus pour une autre question.
Est-il possible "d'Accélérer la copie du classeur actif faite par vba ?"

Je m'explique :
Le but de ce code est de faire une copie dans un dossier "sauvegarde",
- Cette copie doit se faire après l'affectation du résultat d'un appel,
- Pour cette mission, chaque appel dure entre 2 et 6mn en moyenne,
(autant dire qu'il y en a beaucoup, donc autant d'affectations.

J'en viens à ma question :
- Si, par exemple, je fais un copier/coller d'un classeur sur le bureau de mon ordi, il m'est demandé si je veux le renommer et la copie est faite quasi instantanément pour un classeur de moins de 2Mo.

- la copie faite par vba avec le code de Gérard
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Dim fichier1$, chemin$, fichier2$, a$(), n%
fichier1 = ThisWorkbook.Name
If fichier1 Like "* ## ## ##*" Then Exit Sub
ThisWorkbook.Save 'enregistre le fichier
chemin = ThisWorkbook.Path & "\Sauvegarde\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin
fichier2 = Dir(chemin & "*.xlsm")
While fichier2 <> ""
    ReDim Preserve a(n) 'base 0
    a(n) = fichier2
    If n Then Kill chemin & a(n - 1) 'vide le dossier
    n = n + 1
    fichier2 = Dir
Wend
ThisWorkbook.SaveCopyAs chemin & Left(fichier1, Len(fichier1) - 5) & Format(Now, " hh mm ss") & ".xlsm" 'sauvegarde
End Sub
Prend environ 3 secondes, et quelques fois jusqu'à 7 secondes.
Et 3/7 secondes X par un nombre de fois important, ça fini par compter et c'est "un peu barbant" d'attendre chaque fois 3/7 secondes avant de continuer le boulot.

Ma question donc (j'y crois pas trop lol)
Est-il possible "d'Accélérer la copie du classeur actif faite par vba ?"
J'ai fait des recherches cette nuit sans rien trouver pour l'instant.

Mais qui sait avec nos ténors......
Merci à toutes et à tous pour m'avoir lu,
 
Dernière édition:
Trier par date Trier par votes

job75

XLDnaute Barbatruc
Bonjour Lionel, le forum,

Je viens de tester avec un fichier de 3 Mo (162 000 lignes).

La macro s'exécute chez moi en 1 seconde.

Dans le ThisWorkbook du fichier d'origine il y avait des macros, les as-tu bien supprimées ?

A+
 
Dernière édition:
Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Lionel, Job,
Si on reprend le problème au début, il s'agit d'enregistrer les infos d'un appel pour en faire l'historique, si j'ai bien compris.
Dans ce cas pourquoi enregistrer des fichiers XL ? Pourquoi ne pas construire un fichier texte pour l'historique ?
L'avantage est de ne faire qu'un petit fichier texte et d'être beaucoup plus rapide.
Si vous voulez tester, mettez ces deux PJ au même endroit, et dans le fichier XL chaque appui sur "Enregistrement" ajoute les 10 champs ainsi que la date à la suite du fichier texte, chez moi un enregistrement dure environ 3ms.
Le bouton "Ouvrir" ouvre le fichier texte qui est traité comme un csv.
 

Pièces jointes

  • Essai historique.xlsm
    20.4 KB · Affichages: 2
  • Essai historique.txt
    9.8 KB · Affichages: 1
Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc
Bonjour le fil

[aparté - read only - forget after reading]
Et 3/7 secondes X par un nombre de fois important, ça fini par compter et c'est "un peu barbant" d'attendre chaque fois 3/7 secondes avant de continuer le boulot.
Cliquez pour agrandir...
Je viens juste de terminer une réunion "de boulot" qui a duré plus de 2 heures.
Cliquez pour agrandir...
Si le temps est une "valeur maitresse"
alors éviter autant que faire se peut de faire des réunions de boulot
Car il parait que ...
[/aparté - read only - forget after reading]
 
Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc
Bjr sylvanu
Merci pour ton retour...

"Si on reprend le problème au début, il s'agit d'enregistrer les infos d'un appel pour en faire l'historique"
Ce n'est cela mon besoin qui est de Faire une copie de mon classeur quand "Target" change
Tel que le fait le fichier joint avec le code de Gérard.
Son code, au clic sur la cellule B1 (en laissant mon fichier actif ouvert)
- Fait la copie du classeur et le met dans le dossier "sauvegarde" en ajoutant à son nom l'heure-mn-sec de la copie,
- Ne laisse dans le dossier sauvegarde que les 2 dernières copies,
 

Pièces jointes

  • isiTel_Lionel Sextant 2023 06 16.xlsb
    25.9 KB · Affichages: 1
Dernière édition:
Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc
job75 à dit:
Bonjour Lionel, le forum,

Je viens de tester avec un fichier de 3 Mo (162 000 lignes).

La macro s'exécute chez moi en 1 seconde.

Dans le ThisWorkbook du fichier d'origine il y avait des macros, les as-tu bien supprimées ?

A+
Cliquez pour agrandir...
Re-Bjr Gérard,
Je sais d'avance ce que tu vas penser lol...
Quand j'ai voulu intégrer ton code dans le fichier de travail, je me suis aperçu qu'il me fallait exécuter ton code en Private Sub Worksheet_SelectionChange(ByVal R As Range)
J'ai donc fait comme suit :
Dans la feuille "Appel"
VB: 
Private Sub Worksheet_SelectionChange(ByVal R As Range)
If Not Intersect(R, Range("I4")) Is Nothing Then: sécurité: [a1].Select
etc...
Et j'ai créé la macro "sécurité" en y insérant ton code
Code: 
Sub sécurité()
Dim t#
t = Timer
If [m1] = "TEXTBOX OUVERT" Then Exit Sub
    If [p4] > 0 Then
        ActiveCell.Offset(0, 5).Select
        Exit Sub
    End If

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim fichier1$, chemin$, fichier2$, a$(), n%
fichier1 = ThisWorkbook.Name
If fichier1 Like "* ## ## ##*" Then Exit Sub
ThisWorkbook.Save 'enregistre le fichier
chemin = ThisWorkbook.Path & "\Sauvegarde\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin
fichier2 = Dir(chemin & "*.xlsb")
While fichier2 <> ""
    ReDim Preserve a(n) 'base 0
    a(n) = fichier2
    If n Then Kill chemin & a(n - 1) 'vide le dossier
    n = n + 1
    fichier2 = Dir
Wend
ThisWorkbook.SaveCopyAs chemin & Left(fichier1, Len(fichier1) - 5) & Format(Now, " hh mm ss") & ".xlsb" 'sauvegarde

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Durée " & Format(Timer - t, "0.00 \s"), , "Exécution"
End Sub
Le fichier de travail contient :
- onglet Appels environ 10000 lignes et pas de formule, que des valeurs,
- une douzaines d'autres onglets, peu de lignes et pas de formule, que des valeurs,
- taille -de 2Mo,
- dans le ThisWorkbook = beaucoup de codes

Pas de souci du côté fonctionnement.... C'est nickel
Souci : uniquement le temps d'exécution,
 
Dernière édition:
Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc
Re-Bjr
Je m'aperçois que le temps de la copie est similaire au temps de la fermeture de mon classeur.
A la fermeture, le "Private Sub Workbook_BeforeClose(Cancel As Boolean)" procède à plusieurs vérifications avant d'autoriser la fermeture du classeur.

Je suis en train de me poser une question :
Le code de Gérard n'exécuterait-il pas le code "Private Sub Workbook_BeforeClose(Cancel As Boolean)" quand il fait sa copie, ce qui n'est pas utile.
Si c'est le cas : est-il possible de ne pas l'exécuter ?
Serait-ce une sauvegarde et non une copie ?
 
Dernière édition:
Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc
Re-Bjr
Il me semble avoir trouvé la solution :
J'ai remplacé "ThisWorkbook.Save 'enregistre le fichier"
Par "ThisWorkbook.SaveCopyAs FileName"
ça semble bien fonctionner et le temps de copie est bien entre 0.4 et 0.6 sec.
Donc problème de temps résolu me semble-t-il

Et Grrrr !!! je me suis aperçu d'un autre souci lol
(Je pense et j'espère que ce sera le dernier)

Imaginons qu'Excel ou l'ordi se plante.
Je vais donc repartir de ma dernière copie dans "sauvegarde"
isiTel_Amal3 Sextant 2023 06 16 14 18 55

Pour que la copie reste opérationnelle, j'ai neutralisé la ligne
"If fichier1 Like "* ## ## ##*" Then Exit Sub"
Et la copie fonctionne :

Mais...
A la copie suivante il ajoute au bout du nom l'heure mn ss soit :
isiTel_Amal3 Sextant 2023 06 16 14 18 55 14 24 21
Et je pense que les ajouts continuerons.....
Il faudrait donc que 14 24 21 remplace 14 18 55
Je continue de chercher pour ce souci....
 
Dernière édition:
Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc
Bjr à toutes et à tous
Enfin, je pense avoir trouvé après bien des tentatives, recherches etc. et "crises de nerf"


Voilà ce que donnerait le code :
VB: 
Sub sécurité()
Dim t#
t = Timer
If [m1] = "TEXTBOX OUVERT" Then Exit Sub
    If [p4] > 0 Then
        ActiveCell.Offset(0, 5).Select
        Exit Sub
    End If

Dim fichier1$, chemin$, fichier2$, a$(), n%
fichier1 = ThisWorkbook.Name
'If fichier1 Like "* ## ## ##*" Then Exit Sub
'ThisWorkbook.Save 'enregistre le fichier
ThisWorkbook.SaveCopyAs FileName
chemin = ThisWorkbook.Path & "\Sauvegarde\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin
fichier2 = Dir(chemin & "*.xlsb")
While fichier2 <> ""
    ReDim Preserve a(n) 'base 0
    a(n) = fichier2
    If n Then Kill chemin & a(n - 1) 'vide le dossier
    n = n + 1
    fichier2 = Dir
Wend
If fichier1 Like "* ## ## ## ## ##*" Then
ThisWorkbook.SaveCopyAs chemin & Left(fichier1, Len(fichier1) - 14) & Format(Now, " hh mm ss") & ".xlsb" 'sauvegarde
Else
ThisWorkbook.SaveCopyAs chemin & Left(fichier1, Len(fichier1) - 5) & Format(Now, " hh mm ss") & ".xlsb" 'sauvegarde
End If
'isiTel_Amal Sextant 2023 06 16 08 34 43
MsgBox "Durée " & Format(Timer - t, "0.00 \s"), , "Exécution"
End Sub
Grâce au code de job75 que j'ai pu "un peu comprendre",
Mes 1er essais sont OK
:!)
 
Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc
Bjr Gérard
"essayer de modifier les codes qu'on te donne alors que tu n'as pas fait l'effort de les comprendre"
Je suis bien d'accord car, ne les comprenant pas, je tente d'adapter à mon utilisation finale par essais.

Comme je l'ai dit, le ThisWorkbook de mon fichier de travail contient des codes et je ne peux pas les enlever.
Mais tu veux bien me dire pourquoi "ThisWorkbook.SaveCopyAs FileName" serait une erreur ? Puisque je n'ai pas besoin de sauvegarder mais de copier à l'instant voulu.

Pourtant, le code semble très bien fonctionner tel qu'au #post 11, du moins pour tous les tests que j'ai fait :
- Fichier isiTel_Lionel Sextant 2023 06 16 ...................= il ajoute bien au nom de à la copie h mm ss,
- Fichier isiTel_Lionel Sextant 2023 06 16 15 17 33 = il remplace bien 15 17 33 par les nv hh mm ss.
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

C
  • Résolu(e)
Autres Copier des données vers une nouvelle feuille excel VBA
2
Réponses
25
Affichages
577
Carolinebd
C
  • Résolu(e)
XL 2021 Faire une copie de mon classeur quand "Target" change
2 3
Réponses
30
Affichages
2 K
Usine à gaz
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
540
marie3107
M
J
  • Résolu(e)
XL 2021 plantage lors d'un export format PDF
Réponses
14
Affichages
782
JPaul78
J
P
  • Question
XL 2019 Changer nom d'export en VBA
Réponses
3
Affichages
483
job75
J
  • Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
59
JJ69
J
Z
  • Question
XL 2021 VBA Prélèvement d'une donnée si une valeur recherchée est identique
Réponses
3
Affichages
391
ZiM
Z
  • Question
XL 2021 coller une image interne au classeur
2 3
Réponses
33
Affichages
1 K
Jouxte
G
  • Question
XL 2016 Extraire des données d'un pdf et les copier dans excel
2
Réponses
17
Affichages
813
gali2
G
F
  • Résolu(e)
XL 2021 fermeture du classeur après apple d'un userform d'un autre classeur ouvert
Réponses
2
Affichages
311
farid
F
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…