Discussion :

[rapheb]

Bonjour à tous,

Après plusieurs recherches et essais je n'ai pas réussi à obtenir ce que je souhaitais.
Ma macro me sert à importer des classeurs dans un autre classeur (où est situé la macro) via la commande: "Application.GetOpenFilename".

Cela donne le bout de code suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Dim OuvrirFichiers As Variant
OuvrirFichiers = Application.GetOpenFilename(, , , , True)
For y = 1 To UBound(OuvrirFichiers)
Workbooks.Open OuvrirFichiers(y)
Sheets.Select
Sheets.Copy after:=Workbooks("OutilVBA.xls").Sheets(1)

J'utilise donc la sélection multiple.

Ma problématique: fermer, une fois copié, les classeurs ouverts avec Application.GetOpenFilename.
2 techniques pour cela qui ne me conviennent pas:
- utiliser le nom des classeurs pour les fermer workbooks.close (mais je ne suis pas à l'abris que les classeurs que je souhaite importer change de nom...)
- fermer tous les classeurs sauf celui qui contient la macro (problème pour l'utilisateur s'il travail avec d'autres classeurs qui ne souhaite pas fermer)

La solution serait de nommer temporairement les classeurs ouverts puis utiliser ce "nom temporaire" pour les fermer via workbooks.close.... est ce possible ? ou avez vous d'autres solutions ?

merci pour votre aide,
raphaël

[casefayere]

Bonjour,
Je ne comprends peut-être as mais si tu les ouvres un à un dans ta boucle, tu dois pouvoir les fermer de la même façon, je n'ai pas analysé ou testé ton code mais la logique voudrait que, si je m'appuie sur ton code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Dim OuvrirFichiers As Variant
OuvrirFichiers = Application.GetOpenFilename(, , , , True)
For y = 1 To UBound(OuvrirFichiers)
    Workbooks.Open OuvrirFichiers(y)
    Sheets.Select
    Sheets.Copy after:=Workbooks("OutilVBA.xls").Sheets(1)
    Workbooks.Close OuvrirFichiers(y)' à revoir comment fermer ou
    'ActiveWindow.Close
Next y

[rapheb]

Oui la solution doit être comme ça: fermer le classeur avant de passer au next y.
J'ai essayé ta ligne supplémentaire mais excel n'apprecie pas trop:
"Erreur de compilation:
Nombre d'arguments incorrecte ou affectation de propirété incorrets"

[casefayere]

Je n'avais pas vérifié cette ligne mais le classeur actif doit être le dernier classeur ouvert alors essayes (comme je l'ai suggéré) avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveWindow.Close

[rapheb]

J'avais aussi essayé Activewindow.close
Le problème c'est que justement la dernier classeur actif est OutilVBA.xls car on a copié dedans le classeur ouvert précédemment...
Comment gardé le classeur ouvert actif ? ou alors comment ne pas activé le classeur dans lequel on vient de copier nos données ?
On approche !

[mercatog]

Bonjour

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim OuvrirFichiers As Variant
Dim Wbk As Workbook
Dim y As Integer
 
Application.ScreenUpdating = False
OuvrirFichiers = Application.GetOpenFilename(, , , , True)
If IsArray(OuvrirFichiers) Then
    For y = 1 To UBound(OuvrirFichiers)
        Set Wbk = Workbooks.Open(OuvrirFichiers(y))
        Wbk.Sheets.Copy after:=ThisWorkbook.Sheets(1)
        Wbk.Close False
        Set Wbk = Nothing
    Next y
End If

[rapheb]

C'est parfait ! Merci mercatog.
Le code m'a l'air plus propre comme ça en passant.
je ne connaissais pas "Set Wbk = Nothing"
Apparement c'est pour économiser de la mémoire..
Merci à vous deux !

[mercatog]

Bonjour
Essaies d'ajouter un filtre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
OuvrirFichiers = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")

[rapheb]

Par contre, je n'ai pas précisé que je passais par un Userform pour lancer ma macro... du coup, à cause du ScreenUpdating je suis obligé de fermer mon Userform à la fin de ma macro pour voir ce que j'ai importé (or j'ai d'autres macros à lancer avec...) Pour l'instant je l'ai mis sur True pour pouvoir l'utiliser, mais c'est vrai que c'est pratique, puis pour le style on peut l'accompagner d'une ProgressBar

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim OuvrirFichiers As Variant
Dim Wbk As Workbook
Dim y As Integer
 
Application.ScreenUpdating = False
OuvrirFichiers = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
If IsArray(OuvrirFichiers) Then
    For y = 1 To UBound(OuvrirFichiers)
        Set Wbk = Workbooks.Open(OuvrirFichiers(y))
        Wbk.Sheets.Copy after:=ThisWorkbook.Sheets(1)
        Wbk.Close False
        Set Wbk = Nothing
    Next y
End If
Application.ScreenUpdating = True

[rapheb]

Bonjour,
je reviens vers vous pour une petite question sur mon Application.GetOpenFilename

Pour permettre à l'utilisateur d'annuler son action d'ouverture de fichier (click sur 'annuler') j'ai mis en ligne 6:If OuvrirFichiers = False Then Exit Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dim OuvrirFichiers As Variant
Dim Wbk As Workbook
Dim y As Integer
Application.ScreenUpdating = False 'Desactivation du ScreenUpdating
OuvrirFichiers = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , , , True) 'Boite de dialogue Parcourir
If OuvrirFichiers = False Then Exit Sub
 
Waiting.Show False 'userform non modal
Application.Wait (Now + TimeValue("00:00:02")) 'délai 2 secs pour laisser Waiting se charger
 
 
If IsArray(OuvrirFichiers) Then
For y = 1 To UBound(OuvrirFichiers) 'multiselection
Set Wbk = Workbooks.Open(OuvrirFichiers(y)) 'ouvre le classeur
Wbk.Sheets.Copy after:=ThisWorkbook.Sheets(1) 'copie les onglets
Wbk.Close False 'ferme le classeur
Set Wbk = Nothing 'libere la memoire
Next y 'classeur suivant
End If

Ca fonctionne très bien, l'utilisateur peut 'annuler'. Par contre, s'il décide d'ouvrir un ou des fichiers (mulstiselection) une erreur apparait: 'Incompatibilité de type'...
J'ai l'impression que ça vient de mon critère True pour ma multiselection

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

OuvrirFichiers = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , , , True)

Sans la multiselection pas de probleme..

J'ai essayé le On error goto (derniere ligne End Sub)
mais pas satisfaisant, il execute qd meme le code qui suit (filter, fusion et creation d'onglets,, creation colonnes, etc.) mais sans les fichiers importés, dc dans le vide... Il ne va dc pas directement à End Sub.. Pourquoi ?

Des suggestions ?
Merci

[mercatog]

ca revient à vérifier si OuvrirFichier est un tableau. Regarde le code précédent

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Dim OuvrirFichiers As Variant
Dim Wbk As Workbook
Dim y As Integer
 
OuvrirFichiers = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , , , True)    'Boite de dialogue Parcourir
If IsArray(OuvrirFichiers) Then
    Application.ScreenUpdating = False                               'Desactivation du ScreenUpdating
    Waiting.Show False                                               'userform non modal
    Application.Wait (Now + TimeValue("00:00:02"))                   'délai 2 secs pour laisser Waiting se charger
    For y = 1 To UBound(OuvrirFichiers)                              'multiselection
        Set Wbk = Workbooks.Open(OuvrirFichiers(y))                  'ouvre le classeur
        Wbk.Sheets.Copy after:=ThisWorkbook.Sheets(1)                'copie les onglets
        Wbk.Close False                                              'ferme le classeur
        Set Wbk = Nothing                                            'libere la memoire
    Next y                                                           'classeur suivant
End If