Problème avec Application.GetOpenFilename si fichier sélectionné = fichier ouvert

blord

XLDnaute Impliqué
Bonjour à tous,

J'utilise Application.GetOpenFilename pour faire afficher la boite de dialogue qui permet à l'utilisateur d'ouvrir le fichier désiré.

Le problème est que l'utilisateur peut sélectionner tous les fichiers qui sont affichés. Mon code intercepte l'erreur si la feuille que l'on doit copier n'est pas dans le fichier ouvert ou si l'utilisateur ne sélectionne aucun fichier mais je ne suis pas capable d’intercepter l’erreur si l'utilisateur sélectionne le fichier qui est déjà ouvert...

Voici mon code :

Code:
Sub ChoixFichier()
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Copie des données la facture électronique dans le classeur macro
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Affiche les feuille de travail
    Application.ScreenUpdating = False
    Worksheets("Members With Budgeted Rates").Visible = True
    Worksheets("Stub").Visible = True


'Vide la feuille DataFactureEl qui reçoit les données de la facture électronique
    Sheets("Members With Budgeted Rates").Cells.Delete Shift:=xlUp
    Range("A1").Select
    

'Déclaration des variables
    Dim wbSource As String
    Dim Fichier As Variant
    
    
'Attribution du nom du classeur macro à la variable wbSource
    wbSource = ActiveWorkbook.Name

    
'Affiche la boîte de dialogue "Ouvrir"
'Attribue le nom du fichier choisi à la variable Fichier
    Fichier = Application.GetOpenFilename("Tous les fichiers (*.xls),*.xls")
    
    
'On sort si aucun fichier n'a été sélectionné ou si l'utilisateur a cliqué sur le bouton Annuler ou sur la croix de fermeture
    If Fichier = False Then Exit Sub
    
'Ouvre le fichier sélectionné
    Workbooks.Open Filename:=Fichier
  

'Associe le nom du fichier ouvert à la variable wbFacture
    Set wbFacture = ActiveWorkbook

'On tente d'accéder à la feuille qui contient les informations de facturation
    On Error Resume Next
    Set shFacture = wbFacture.Worksheets("Detailed billing information")
    
'Si la feuille est inexistante : message d'erreur
    If Err.Number <> 0 Then
        MsgBox "The file selected does not include a 'Detailed billing information' sheet." & Chr(10) & _
        "Please ensure that you have chosen a valid billing file and that the sheet is not deleted, hidden or renamed.", vbExclamation
        Workbooks(wbFacture.Name).Close SaveChanges:=False
        Application.DisplayAlerts = True
        Exit Sub
    End If
    On Error GoTo 0

'Copie des données de facturation dans le classeur macro dans la feuille "DataFactureEl"
    shFacture.Activate
    Cells.Copy
    Workbooks(wbSource).Activate
    Sheets("Members With Budgeted Rates").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1").Select
    
'Fermeture du classeur de la facture électronique
    Workbooks(wbFacture.Name).Close SaveChanges:=False
    Workbooks(wbSource).Activate
    Application.EnableEvents = True

End Sub

Donc ce que j'aimerais c'est que mon code ne "plante pas" si le fichier sélectionné pour ouverture est celui qui est déjà ouvert.

Merci pour votre aide !

Benoit Lord
 

blord

XLDnaute Impliqué
Re : Problème avec Application.GetOpenFilename si fichier sélectionné = fichier ouver

Bonjour carcharodon-carcharias, le Forum,

Désolé, mais il n'affiche pas le message de cette section du code :

If Fichier = wbSource Then
Call MsgBox("le classeur que vous avez choisi est déjà ouvert ", vbCritical, "Opération impossible ")
Exit Sub
End If

Il passe directement à la boite de dialogue Excel :
Le fichier xxx.xls est déjà ouvert. Si vous l'ouvrez à nouveau etc...

Si on clique sur Non le code bug sur cette ligne :
Workbooks.Open Filename:=Fichier

???

Benoit Lord
 

Bebere

XLDnaute Barbatruc
Re : Problème avec Application.GetOpenFilename si fichier sélectionné = fichier ouver

bonjour
il faut enlever le chemin
changement à effectuer
'ici
nomFichier = Mid(Fichier, InStr(Fichier, "\") + 1)
nomFichier = Mid(nomFichier, InStr(nomFichier, "\") + 1)
If nomFichier = wbSource Then
Call MsgBox("le classeur que vous avez choisi est déjà ouvert ", vbCritical, "Opération impossible ")
Exit Sub
End If
 

blord

XLDnaute Impliqué
Re : Problème avec Application.GetOpenFilename si fichier sélectionné = fichier ouver

Bonjour Bebere, le Forum.

C'est peut-être moi qui n'ait pas compris mais j'ai placé le bout de code donné à partir de 'ici jusqu'au end if dans mon code mais toujours le même problème...

???

Benoit Lord
 

blord

XLDnaute Impliqué
Re : Problème avec Application.GetOpenFilename si fichier sélectionné = fichier ouver

Bonjour carcharodon-carcharias, Bebere, le Forum,

J'ai finalement compris ce que Bebere voulait dire par enlever le chemin...

La fonction Application.GetOpenFilename renvoie le nom incluant le chemin complet du fichier comme par exemple : C:\Users\Benoit\Documents\Desjardins\541383 - AMICO\Fichier 123.xls

Donc en comparant le nom retourné par le GetOpenFileName avec le wbSource, on ne comparait pas le même chaîne de caractères le wbSource n'ayant que le nom du fichier et non le chemin complet d'où la suggestion de Bebere d'enlever le chemin.

Pourquoi le code de Bebere ne fonctionnait pas ? À cause de la fonction InStr qui commence la recherche au début de la chaîne de caractère et non pas à partir de la fin. Ainsi, en utilisant la fonction InStrRev dans le code suivant :

nomFichier = Mid(Fichier, InStrRev(Fichier, "\") + 1)
nomFichier = Mid(nomFichier, InStrRev(nomFichier, "\") + 1)
If nomFichier = wbSource Then
Call MsgBox("le classeur que vous avez choisi est déjà ouvert ", vbCritical, "Opération impossible ")
Exit Sub

La comparaison des deux noms de fichiers se fait correctement et le message prévu s'affiche....

Merci à vous pour votre aide ce qui m'a finalement permis de résoudre mon problème...

Bonne fin de journée !

Benoit Lord
 

Staple1600

XLDnaute Barbatruc
Re : Problème avec Application.GetOpenFilename si fichier sélectionné = fichier ouver

Bonsoir le fil

Une autre façon de faire (que personnellement j'affectionne ;) )

Code:
Sub a()
Dim test$, nomfichier$
test = "C:\Users\Benoit\Documents\Desjardins\541383 - AMICO\Fichier 123.xls"
'nomfichier = Mid(nomfichier, InStrRev(nomfichier, "\") + 1)
nomfichier = Split(test, "\")(UBound(Split(test, "\")))
MsgBox nomfichier
End Sub
 

Discussions similaires

Réponses
7
Affichages
526

Statistiques des forums

Discussions
314 490
Messages
2 110 139
Membres
110 684
dernier inscrit
kihel