Microsoft 365 Code VBA - prise en compte de tous les types des extensions des fichiers Excel à ouvrir

[RCAVBA]

Bonjour à tous,

Je souhaiterais modifier mon code ci-dessous à telle sorte de prendre en compte tous les types d'extensions sans faire rentrer une extension donnée.

L'objectif est d'ouvrir un fichier via la fonction en renseignant au préalable dans des cellules le dossier du fichier, le nom du fichier ainsi que l'extension:

If (TestFichierOuvert(nom_fichier_origine + extension) = True) Then Workbooks.Open Filename:=adresse_dossier_du_fichier+ "\" + nom_du_fichier + extension

Serait-il possible de ne pas renseigner l'extension et de prendre en compte tous les types d'extension : xls, xlsx, xlsb...

NB. l'extension est une variable dans mon code.

Merci

Cdt,

 

[fanch55]

Bonsoir,
Cela fait au moins 10 ans qu'on ne fait fait plus de concaténation avec le + , on utilise le & .
Pour ouvrir un fichier, on ne peut pas déterminer tout seul si c'est un xls, un xlsm ou autre xls*, il faut afficher un FileDialog avec le masque approprié (xl*) et laisser l'utilisateur décider.
Veux-tu un exemple ?

 

[RCAVBA]

Merci @fanch55 pour la réponse.
Oui je veux bien.
Sinon y a pas moyen de prendre en compte toutes les extensions d’une façon automatique ?

 

[fanch55]

Prendre toutes les extensions, oui, mais lequel ouvrir ?

 

[fanch55]

A essayer et adapter :

Sub test()

    With Application.FileDialog(msoFileDialogFilePicker)
         .Title = "Importer un Fichier"
         .InitialFileName = ThisWorkbook.Path & "\" & nom_fichier_origine & ".xl*"
         .AllowMultiSelect = False
         .Filters.Clear
         .Filters.Add "Mon fichier à moi", "*.xl*"
         If .Show Then MsgBox .SelectedItems(1)
    End With
End Sub

Le .selecteditems(1) est le fichier que tu veux ouvrir ....

 

[RCAVBA]

A essayer et adapter :

Sub test()

    With Application.FileDialog(msoFileDialogFilePicker)
         .Title = "Importer un Fichier"
         .InitialFileName = ThisWorkbook.Path & "\" & nom_fichier_origine & ".xl*"
         .AllowMultiSelect = False
         .Filters.Clear
         .Filters.Add "Mon fichier à moi", "*.xl*"
         If .Show Then MsgBox .SelectedItems(1)
    End With
End Sub

Le .selecteditems(1) est le fichier que tu veux ouvrir ....

Bonjour,
ça ne marche pas en remplaçant extension par ".xl*" :

        If (TestFichierOuvert(nom_fichier + ".xl*") = True) Then
            Workbooks.Open Filename:=adresse_fichier + "\" + nom_fichier + ".xl*"
        End If

Je rappelle que l'objectif est de pouvoir ouvrir tous les fichier Excel que ce soit leurs extensions..

Merci
Cdt,

 

[fanch55]

A première vue, tu ne sais pas adapter
Essayes avec cette macro :

Public Nom_Fichier_Origine As String
Sub Test()
Dim Classeur            As Workbook
Dim To_Open             As Boolean

    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Importer un Fichier"
        .InitialFileName = Nom_Fichier_Origine
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Mes Extensions à moi", "*.xl*"
        If .Show Then
            Nom_Fichier_Origine = .SelectedItems(1)
            To_Open = True
            For Each Classeur In Workbooks
                If Classeur.Name = Nom_Fichier_Origine Then
                    To_Open = False
                    Classeur.Activate
                    Exit For
                End If
            Next
            If To_Open Then Workbooks.Open Filename:=Nom_Fichier_Origine
        End If
    End With
    
End Sub

 

[fanch55]

Pourquoi ce mouvement d'humeur ?
La macro ne fait pas ce que tu veux ?
Quand je dis que tu n'as pas su adapter, ce n'est pas un reproche .

 

[patricktoulon]

bonjour

Sub ouvre1()
'ouverture un seul fichier
    Dim Fichier As Variant
     Fichier = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*", , "Ouvrir un Classeur")
    If Fichier <> False Then
        MsgBox "Fichier sélectionné " & vbCrLf & Fichier
    End If
End Sub

tu n'aura de dispo que les dossiers , raccourcis , et les fichiers Excel dans la boite de dialog

et si il est question de multiselect

Sub ouvre2()
'ouverture un !! ou !!! plusieurs !!  fichiers en gardant la touche control appuyée
    Dim Fichier As Variant, i&
    Fichier = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*", , "Ouvrir un Classeur")
     If IsArray(Fichier) Then
        For i = LBound(Fichier) To UBound(Fichier)
            MsgBox Fichier(i)
        Next
    ElseIf Not IsArray(Fichier) Then
        If Fichier = False Then Exit Sub
        MsgBox Fichier
    End If
End Sub

 

[RCAVBA]

bonjour

Sub ouvre1()
'ouverture un seul fichier
    Dim Fichier As Variant
     Fichier = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*", , "Ouvrir un Classeur")
    If Fichier <> False Then
        MsgBox "Fichier sélectionné " & vbCrLf & Fichier
    End If
End Sub

tu n'aura de dispo que les dossiers , raccourcis , et les fichiers Excel dans la boite de dialog

et si il est question de multiselect

Sub ouvre2()
'ouverture un !! ou !!! plusieurs !!  fichiers en gardant la touche control appuyée
    Dim Fichier As Variant, i&
    Fichier = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*", , "Ouvrir un Classeur")
     If IsArray(Fichier) Then
        For i = LBound(Fichier) To UBound(Fichier)
            MsgBox Fichier(i)
        Next
    ElseIf Not IsArray(Fichier) Then
        If Fichier = False Then Exit Sub
        MsgBox Fichier
    End If
End Sub

Bonjour,

Je pense que j'ai mal exprimé le besoin.

If (TestFichierOuvert(nom_fichier + ".xls") = True) Then
            Workbooks.Open Filename:=adresse_fichier + "\" + nom_fichier + ".xls"
End If

En revanche, quand j'ai essayé en modifiant la ligne comme suit :


En fait, j'ai déjà mon code qui marche très bien et je voulais juste voir s'il y a une possibilité d'accepter toutes les extensions Excel

If (TestFichierOuvert(nom_fichier + ".xls" or ".xlsx") = True) Then

Ni en faisant comme suit :
extension = ".xls" Or ".xlsx"

ça me renvoie un bug

Merci pour votre aide

 

[patricktoulon]

re
et jamais tu nous la montre ta fonction "TestFichierOuvert"

 

[RCAVBA]

voilà

Function TestFichierOuvert(ByVal NomFic As String)

    Dim Classeur As Workbook
    TestFichierOuvert = True
    For Each Classeur In Workbooks
        If (Classeur.Name = NomFic) Then
            TestFichierOuvert = False
        End If
    Next Classeur
    
End Function

 

[patricktoulon]

ben si c'est pour ça pourquoi tu t'ennuie avec l'extension

If TestFichierOuvert(nom_fichier) Then
Workbooks.Open Filename:=adresse_fichier + "\" + nom_fichier + ".xls"
End If

Function TestFichierOuvert(ByVal NomFic As String)
Dim Classeur As Workbook
TestFichierOuvert = True
For Each Classeur In Workbooks
If instr(Classeur.name,NomFic)>0 Then TestFichierOuvert = False:exit for
End If
Next Classeur
End Function

a moins que tu ai des fichiers de même nom mais pas les même extensions
au quel cas je te suggère de revoir la conception générale de ton projet

 

[RCAVBA]

@patricktoulon J'ai plutôt des fichiers à ouvrir avec des extensions différentes : xls, xlsx..

 

[fanch55]

Ok, si j'ai "mieux" compris, tu ne sembles pas vouloir d'interaction genre filedialog mais ouvrir le premier fichier dont le nom est identique à la cellule Nom de Fichier, pourvu que son extension soit gérable par Excel :

Formats de fichier pris en charge dans Excel

Répertorie les formats de fichier pris en charge dans Excel. Cette rubrique inclut également une liste des formats de fichier non pris en charge et des solutions de contournement suggérées.

support.microsoft.com

Il faudrait cependant que tu précises quel est l'ordre de préférence xls puis xlsx puis xlsm puis xlsb etc ... et que faire si le fichier n'existe pas ...