Ouvrir fichier Excel

Version imprimable

Bonjour à tous,

voilà j'ai une macro affectée à un bouton qui me permets d'ouvrir la fenêtre parcourir sur mon PC et de sélectionner un fichier Excel avec l'extension xls, ensuite ce fichier est copier directement sur ma feuille.
Ma demande je souhaite élargir le choix d'extension et de rajouter ". xlsx", j'ai essayé de rajouter cette extension mais ça ne marche pas.
Voici le code, si quelqu'un pourrait m'aider à rajouter la prise en compte de l'extension .xlsx.

par avance merci.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Sub MAJ_Histo()
Call nettoyage_Histo
    Dim a As Variant, Nom As String
 
 
    Nom = ActiveWorkbook.Name
    ChDrive "C:"    ' Choix du lecteur
    ChDir "C:\"    'Choix du répertoire
   a = Application.GetOpenFilename("fichier excel (*.xls), *.xls", _
                                    , "Sélection de vos fichiers excel", , True)
 
 
    Select Case TypeName(a)
    Case Is = "Boolean"
        Exit Sub
    Case Else
        For b = LBound(a) To UBound(a)
            Workbooks.Open a(b)
        Next
    End Select
    Nom2 = ActiveWorkbook.Name
    Cells.Select
    Selection.Copy
 
    'Windows(Nom).Activate
 
    Workbooks("Outil de pilotage VJ1.xlsm").Sheets("Histo").Activate
    With Range("A1")
    .PasteSpecial Paste:=xlPasteValues
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteFormats
    .Application.CutCopyMode = False
End With
 
    Application.DisplayAlerts = False
    Windows(Nom2).Close
    Application.DisplayAlerts = True
'Sheets("Accueil").Select
End Sub
 
Sub MAJ_Convocations()
Call nettoyage_Convocations
    Dim a As Variant, Nom As String
 
    Nom = ActiveWorkbook.Name
    ChDrive "C:"    ' Choix du lecteur
    ChDir "C:\"    'Choix du répertoire
    a = Application.GetOpenFilename("fichier excel (*.xls), *.xls", _
                                    , "Sélection de vos fichiers excel", , True)
 
    Select Case TypeName(a)
    Case Is = "Boolean"
        Exit Sub
    Case Else
        For b = LBound(a) To UBound(a)
            Workbooks.Open a(b)
        Next
    End Select
    Nom2 = ActiveWorkbook.Name
    Cells.Select
    Selection.Copy
 
    'Windows(Nom).Activate
 
    Workbooks("Outil de pilotage VJ1.xlsm").Sheets("Convocations").Activate
    With Range("A1")
    .PasteSpecial Paste:=xlPasteValues
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteFormats
    .Application.CutCopyMode = False
End With
 
    Application.DisplayAlerts = False
    Windows(Nom2).Close
    Application.DisplayAlerts = True

20/07/2015, 13h41
joe.levrai

Bonjour,

Code:

Application.GetOpenFilename("Feuilles de calcul (*.xlsx;*.xlsm;*.xlsb;*.xls), *.xls", , , , True)
20/07/2015, 14h35
salemhacen

Merci pour votre réponse, j'ai mis cette ligne de code:

Code:

a = Application.GetOpenFilename("Feuilles de calcul (*.xlsx;*.xlsm;*.xlsb;*.xls), *.xls, *.xlsx", , , True)

mais j'ai l'erreur : GetOpenFilename de l'objet_ a échoué.

Salutations.
20/07/2015, 14h48
joe.levrai

Entre tes deux extensions *.xls et *.xlsx, c'est un point virgule et pas une virgule

Code:

a = Application.GetOpenFilename("Feuilles de calcul (*.xlsx;*.xlsm;*.xlsb;*.xls), *.xls; *.xlsx", , , True)

et temps qu'à faire, utilises plutôt ça pour ne pas avoir les Xlsm et Xlsb

Code:

a = Application.GetOpenFilename("Feuilles de calcul (*.xlsx;*.xls), *.xls; *.xlsx", , , True)
20/07/2015, 14h54
salemhacen

Merci joe.levrai,

Maintenant ça marche les fichiers avec l’extension .xlsx s'affichent sauf quand je le sélectionne il m'affiche une erreur 13 incompatibilité de type sur cette ligne :

Code:

For b = LBound(a) To UBound(a)

ça

Outre le fait que tu as supprimé un argument à ton GetOpenFilename, qui fait que ton argument Multiselect n'existe plus (ce qui ne me semble pas bloquant en soit) ...

je n'ai aucun souci avec ça :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub ioi() a = Application.GetOpenFilename("Feuilles de calcul (*.xlsx;*.xls), *.xls; *.xlsx", , , , True) Select Case TypeName(a) Case Is = "Boolean" Exit Sub Case Else For b = LBound(a) To UBound(a) MsgBox b Next End Select End Sub
j'ai bien dans chaque MsgBox l'index de sélection de chaque fichier

20/07/2015, 15h27
salemhacen

Merci j'ai rajouter la partie pour copier le fichier que j'ouvre et ça marche comme je veux; j'ai une deuxième question concernant la partie copier coller, est ce que je vous la pose ici ou je dois ouvrir une nouvelle discussion.

Merci
20/07/2015, 15h42
joe.levrai

Si tu peux renommer ton titre de discussion pour "Ouvrir et Copier Fichier Excel", tu peux rester ici

Sinon c'est préférable d'ouvrir un nouveau fil pour exposer clairement ton problème