Microsoft 365 Ouvrir un fichier Excel rapidement en VBA

[iliess]

Je suis actuellement chargé de la gestion comptable sur un logiciel de comptabilité qui me donne la capacité de générer des états financiers sous forme de fichiers Excel. Cependant, un inconvénient notable est la lenteur d'ouverture de ces rapports.
Est-il possible de réduire le temps d’ouverture du classeur en VBA en important, par exemple, l’intégralité de la feuille 1 sans ouvrir le fichier source pour un traitement personnalisé ?
Cordialement.

Est-il possible de joindre mon fichier de démonstration qui fait 12 Mo en taille ?

 

[job75]

Bonjour iliess, wDog66,

Dans le fichier Source.xlsx nommez Tableau la plage que vous voulez récupérer.

Dans le fichier Pilote.xlsm exécutez la macro :

Sub Copier()
Dim fichier As Variant, form$, nlig&, ncol%
fichier = Application.GetOpenFilename("Fichiers Excel (*.xlsx), *.xlsx")
If fichier = False Then Exit Sub
form = "'" & fichier & "'!Tableau"
nlig = ExecuteExcel4Macro("ROWS(" & form & ")")
ncol = ExecuteExcel4Macro("COLUMNS(" & form & ")")
Application.ScreenUpdating = False
Cells.Delete 'RAZ
With [A1].Resize(nlig, ncol)
    .FormulaArray = "=" & form 'formule matricielle
    .Value = .Value 'supprime la formule
    .Replace 0, "", xlWhole 'efface les valeurs zéro
End With
End Sub

Le fichier Source est copié sans qu'on l'ouvre.

A+

 

[Cousinhub]

Bonjour,
@job75 , ne pas oublier d'annoncer au demandeur (sous 365), qu'il faut valider l'autorisation des macros xl4
Bonne fin d'apm

 

[job75]

Si vous ne voulez pas créer le nom Tableau il faut un minimum d'informations :

- le nom de la feuille à copier => "Feuil1"

- le numéro de la ligne des en-têtes => 1

- la nature des valeurs en colonne A ou B (textes ou nombres).

La nouvelle macro :

Sub Copier()
Dim fichier As Variant, chemin$, feuille$, form$, nlig&, ncol%
fichier = Application.GetOpenFilename("Fichiers Excel (*.xlsx), *.xlsx")
If fichier = False Then Exit Sub
chemin = Left(fichier, InStrRev(fichier, "\"))
fichier = Mid(fichier, InStrRev(fichier, "\") + 1)
feuille = "Feuil1" 'nom de la feuille à copier
form = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
'nlig = ExecuteExcel4Macro("MATCH(""zzz""," & form & "C1)") 'textes en colonne A
nlig = ExecuteExcel4Macro("MATCH(9^9," & form & "C2)") 'ou nombres en colonne B
ncol = ExecuteExcel4Macro("MATCH(""zzz""," & form & "R1)") 'ligne des en-têtes
Application.ScreenUpdating = False
Cells.Delete 'RAZ
With [A1].Resize(nlig, ncol)
    .FormulaArray = "=" & form & "R1C1:R" & nlig & "C" & ncol 'formule matricielle
    .Value = .Value 'supprime la formule
    .Replace 0, "", xlWhole 'efface les valeurs zéro
End With
End Sub

 

[job75]

A partir du lien du post #19 j'ai téléchargé le fichier puis exécuté cette macro :

Sub Copier()
Dim fichier As Variant, t, chemin$, feuille$, form$, nlig&, ncol%
fichier = Application.GetOpenFilename("Fichiers Excel (*.xlsx), *.xlsx")
If fichier = False Then Exit Sub
t = Timer
chemin = Left(fichier, InStrRev(fichier, "\"))
fichier = Mid(fichier, InStrRev(fichier, "\") + 1)
feuille = "JournalAuxExcel" 'nom de la feuille à copier
form = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
nlig = ExecuteExcel4Macro("MATCH(""zzz""," & form & "C3)") 'textes en colonne C
ncol = ExecuteExcel4Macro("MATCH(""zzz""," & form & "R5)") 'ligne des en-têtes
Application.ScreenUpdating = False
Cells.Delete 'RAZ
With [A1].Resize(nlig, ncol)
    .FormulaArray = "=" & form & "R1C1:R" & nlig & "C" & ncol 'formule matricielle
    .Value = .Value 'supprime la formule
    .Replace 0, "", xlWhole 'efface les valeurs zéro
End With
MsgBox "Durée " & Format(Timer - t, "0.00 \sec")
End Sub

Elle s'exécute en 34 secondes chez moi, 207 791 lignes sont copiées.

 

[Cousinhub]

Bonjour,
En modifiant le début du code ainsi :

....
Dim Fichier As String
Fichier = Application.GetOpenFilename("XL* Files (*.xls;*.xlsm;*.xlsx), *.xls;*.xlsm;*.xlsx", 1, "ouvrir un fichier")
If Fichier = "" Then Exit Sub
ActiveWorkbook.Queries.Add Name:="JournalAuxExcel", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Excel.Workbook(File.Contents(""" & Fichier & """), null, true)," & Chr(13) & "" & Chr(10) & "    JournalAuxExcel_Sheet = Source{[Item=""JournalAuxExcel"",Kind=""Sheet""]}[Data]" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    JournalAuxExcel_Sheet"
ActiveWorkbook.Worksheets.Add
....
....

Si le nom de l'onglet peut être différent, et qu'il n'y a qu'un seul onglet, tu peux supprimer la partie Item=""JournalAuxExcel"", le code deviendrait alors :

....
Dim Fichier As String
Fichier = Application.GetOpenFilename("XL* Files (*.xls;*.xlsm;*.xlsx), *.xls;*.xlsm;*.xlsx", 1, "ouvrir un fichier")
If Fichier = "" Then Exit Sub
ActiveWorkbook.Queries.Add Name:="JournalAuxExcel", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Excel.Workbook(File.Contents(""" & Fichier & """), null, true)," & Chr(13) & "" & Chr(10) & "    Import = Source{[Kind=""Sheet""]}[Data]" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    Import"
ActiveWorkbook.Worksheets.Add
....
....

 

[Cousinhub]

Re-,
Petite erreur, s'il n'y a pas de sélection...
Remplace par :

If Fichier = "Faux" Then Exit Sub

 

[Cousinhub]

RE-,
Ce code te supprime la 1ère requête (je suppose la seule...)

ActiveWorkbook.Queries.Item(1).Delete

Restera à supprimer l'onglet ajouté

 

[wDog66]

Bonjour Iliess,

Office 365... quelle lenteur aujourd'hui Impensable au pris de l'abonnement payé

Sinon, vous pouvez travailler avec Power Query pour récupérer des données d'un autre fichier

A+

 

[iliess]

Bonjour wdog66
merci pour votre réponse
Effectivement je travaille avec power query et le vba

 

[job75]

J'ai testé avec un tableau de 10 colonnes et 10 000 lignes (fichier de 1,8 Mo).

La durée d'exécution après fermeture de la boîte de dialogue est de 0,6 seconde chez moi.

 

[job75]

En effet, merci Cousinhub.

 

[iliess]

Bonsoir
M @job75 , Merci pour votre solution. Mais le problème, c'est que mon fichier source est très lent à l'ouverture pour nommer la plage Tableau.

 

[iliess]

Bonsoir
M @job75 , M @Cousinhub
Est-ce que je peux modifier la ligne suivante ?

form = "'" & fichier & "'!Tableau"

Par

form = "'" & fichier & "Range("A1").CurrentRegion"

 

[job75]

Bonjour ilies, le forum,

Non car pour obtenir CurrentRegion il faut que le fichier Source soit ouvert.

Prenez votre mal en patience et ouvrez-le pour créer le nom Tableau.

A+