Microsoft 365 Fermeture d'un Fichier Excel si celui-ci est déjà ouvert

[Yoyo60]

Bonjour à toutes et à tous,

Une nouvelle fois je me trouve face à un petit soucis.
Après plusieurs recherches sur différentes pages, je ne trouve pas réponse à ce problème...

Je me permets ces quelques lignes dans l'espoir d'avoir votre aide.

J'utilise 2 fichiers :
- Essai1.xlsm (Emplacement D:\TEST)
- Essai2.xlsm (Emplacement D:\TEST)

Le fichier N°1 contient l'ensemble de mes Macros qui vont traitées mes données à destination de mon fichier N°2.

Actuellement, mes macros fonctionnent toutes À LA CONDITION que le fichier N°2 ne soit pas déjà ouvert...

Et c'est là tout mon problème :-(

J'ai 2 options :
la première, c'est de lancer mes macros et malheureusement, si le fichier N°2 est déjà ouvert, un message d'erreur apparaît (Erreur d'exécution '9' L'indice n'appartient pas à la sélection)
la seconde, en cas de message d'erreur, FERMER MANUELLEMENT le 2ème fichier et relancer mes macros.

J'aimerais pour éviter ce message, faire un test qui me ferme si nécessaire le fichier N°2 pour ensuite poursuivre l'exécution de mes macros.

Comme je disais plus haut, après plusieurs recherches, je suis tombé sur quelques lignes de code dont celles-ci :

Sub TestFichierOuvert()
Dim Verification As Boolean
Dim MonClasseur As String

MonClasseur = "D:\TEST\Essai2.xlsm"


'Test si Fichier Existant
If Len(Dir(MonClasseur)) = 0 Then 'Si pas existant, Avertissement et Fin de Macro
MsgBox "Le classeur n'existe pas ou à été déplacé, impossible de poursuivre.", vbCritical, "Erreur"
Exit Sub
End If

'Si le Classeur existe, vérifier s'il est déjà ouvert
Verification = EstClasseurOuvert(MonClasseur)

If Verification = False Then 'Classeur ouvert
MsgBox "Classeur Ouvert"
Else
Workbooks(MonClasseur).Close SaveChanges:=False
End If
End Sub

Le 1er test pour savoir si le fichier est existant ou non m'importe peu, mais est fonctionnel alors je l'ai laissé (mon fichier existe et le sera toujours, mais sait-on jamais....)

Le 2ème test en revanche me génère une erreur (Erreur d'exécution '9' L'indice n'appartient pas à la sélection).
erreur sur la ligne :
Workbooks(MonClasseur).Close SaveChanges:=False

Auriez vous une idée, une remarque ou mieux encore, une solution afin de fermer automatiquement le fichier N°2 pour le cas ou celui-ci serait déjà ouvert et poursuivre sereinement la suite du code?

Par avance merci pour votre retour.

Excellente journée à toutes et à tous

Johann

 

[TooFatBoy]

Bonjour,

Si le fait qu'un autre classeur soit ouvert provoque des "interférences" sur les macros, c'est peut-être qu'elles ne sont pas bien écrites. Par exemple, elles ne travaillent pas sur le bon classeur.

Du coup, ce serait peut-être ça qu'il faudrait corriger ?

 

[jm.andryszak]

Bonjour
A tester

 

[Yoyo60]

Bonjour
A tester

Bonjour jm

Je ne trouve pas le code dans les deux fichiers que tu proposes.

Peux tu m'éclairer stp

 

[Yoyo60]

Bonjour,

Si le fait qu'un autre classeur soit ouvert provoque des "interférences" sur les macros, c'est peut-être qu'elles ne sont pas bien écrites. Par exemple, elles ne travaillent pas sur le bon classeur.

Du coup, ce serait peut-être ça qu'il faudrait corriger ?

Bonjour TooFatBoy

Je pense pas que se soit une ''interférences". Mais qui sait....

J'ai obtenu ce code publié y'a déjà longtemps et il semblait fonctionné aux dires des utilisateurs de l'époque.

c'est Workbooks(MonClasseur).Close qui semble ne pas aller.

Pourtant quand je fais une recherche, il ne semble pas y avoir d'erreur dans l'écriture.

Quelqu'un voit-il autre chose svp ?

 

[mapomme]

Bonjour à tous,

Essayez cette procédure RefermerFichier(...) qui referme un classeur qu'il soit ouvert ou non, qu'il existe ou non.
Votre erreur semble provient du fait que le nom du classeur dans Workbooks ne doit comporter ni le lecteur ni le chemin.

Sub Test()
Dim MonClasseur
   MonClasseur = "c:\toto\aRefermer.xlsx"
   RefermerFichier MonClasseur
End Sub

Sub RefermerFichier(ByVal CheminNom As String)
Dim NomClasseur As String
   NomClasseur = Mid(CheminNom, InStrRev(CheminNom, "\") + 1)     ' nom du classeur à fermer (juste son nom)
   On Error Resume Next                                           ' en cas d'erreur, on continue
   Application.Workbooks(NomClasseur).Close SaveChanges:=False    ' on referme le fichier (on continue si erreur)
   On Error GoTo 0                                                ' on intercepte à nouveau les erreurs
End Sub

 

[mapomme]

Re,

Une autre procédure qui n'utilise pas la gestions des erreurs (je préfére celle-ci car elle est indépendante de l'option de VBA "Arrêt sur toutes les erreurs à VRAI sur les postes des exécutants - configuration qu'on ne maitrise pas).

Sub RefermerFichier(ByVal CheminNom As String)
Dim NomClasseur As String, xwkb
   NomClasseur = LCase(Mid(CheminNom, InStrRev(CheminNom, "\") + 1))    ' nom du classeur à fermer (juste son nom)
   For Each xwkb In Workbooks    ' pour chaque classeur ouvert
      ' si le classeur est ouvert, on le referme et on quitte la procédure
      If LCase(xwkb.Name) = NomClasseur Then xwkb.Close SaveChanges:=False: Exit Sub
   Next xwkb
End Sub

 

[Yoyo60]

Bonjour à tous,

Essayez cette procédure RefermerFichier(...) qui referme un classeur qu'il soit ouvert ou non, qu'il existe ou non.
Votre erreur semble provient du fait que le nom du classeur dans Workbooks ne comporte ni le lecteur ni le chemin.

Sub Test()
Dim MonClasseur
   MonClasseur = "c:\toto\aRefermer.xlsx"
   RefermerFichier MonClasseur
End Sub

Sub RefermerFichier(ByVal CheminNom As String)
Dim NomClasseur As String
   NomClasseur = Mid(CheminNom, InStrRev(CheminNom, "\") + 1)     ' nom du classeur à fermer (juste son nom)
   On Error Resume Next                                           ' en cas d'erreur, on continue
   Application.Workbooks(NomClasseur).Close SaveChanges:=False    ' on referme le fichier (on continue si erreur)
   On Error GoTo 0                                                ' on intercepte à nouveau les erreurs
End Sub

Bonjour mapomme

Merci pour votre participation.

Ca fonctionne parfaitement. J'ai comme indiqué remplacé CheminNom et NomClasseur par le nom du classeur ("Essai1") sans l'extension et le résultat fonctionne.

Un grand merci à vous pour le temps passé.

Excellent week-end

 

[TooFatBoy]

Je pense pas que se soit une ''interférences". Mais qui sait....

Pourtant, s'il n'y a pas de pb quand c'est le seul classeur ouvert...

J'ai obtenu ce code publié y'a déjà longtemps et il semblait fonctionné aux dires des utilisateurs de l'époque.

Ont-ils testé avec plusieurs classeurs ouverts en même temps ???

c'est Workbooks(MonClasseur).Close qui semble ne pas aller.

C'est uniquement quand tu veux fermer ton classeur, qu'il y a un problème si un autre classeur est ouvert ?

 

[mapomme]

J'ai comme indiqué remplacé CheminNom et NomClasseur par le nom du classeur ("Essai1") sans l'extension et le résultat fonctionne.

Non ce n'est comme cela qu'il faut l'utiliser !

Vous placez le code (sans le changer) de la procédure RefermerFichier(...) dans un module.

Et dans le code de votre application, vous appelez cette procédure comme dans Sub Test().

On ne touche pas à l'argument CheminNom ( voyez la procédure Test() ). On exécute simplement dans cotre code principal:

RefermerFichier MonClasseur

C'est la procédure RefermerFichier(...) qui se charge de tout (enlever le chemin du fichier et refermer le classeur).

 

[jm.andryszak]

Bonjour
le code dans un module de essai1
est :
Option Explicit
Sub TestFichierOuvert()
Dim Verification As Boolean
Dim ClasseurFullName As String
Dim ClasseurShortName As String

ClasseurFullName = "D:\TEST\Essai2.xlsm"
ClasseurShortName = Split(ClasseurFullName, "\")(UBound(Split(ClasseurFullName, "\"))) 'Essai2.xlsm

'Test si Fichier Existant
If Len(Dir(ClasseurFullName)) = 0 Then 'Si pas existant, Avertissement et Fin de Macro
MsgBox "Le classeur n'existe pas ou à été déplacé, impossible de poursuivre.", vbCritical, "Erreur"
Exit Sub
Else
If EstClasseurOuvert(ClasseurShortName) = True Then
Workbooks(ClasseurShortName).Close SaveChanges:=False
Poursuite
Else
Poursuite
End If
End If
End Sub
Function EstClasseurOuvert(ClasseurShortName As String) As Boolean
Dim Wb As Workbook
On Error Resume Next
Set Wb = Workbooks(ClasseurShortName)
EstClasseurOuvert = (Not Wb Is Nothing)
End Function
Sub Poursuite()
MsgBox "poursuivre l'exécution de mes macros."
End Sub

 

[Yoyo60]

Non ce n'est comme cela qu'il faut l'utiliser !

Vous placez le code (sans le changer) de la procédure RefermerFichier(...) dans un module.

Et dans le code de votre application, vous appelez cette procédure comme dans Sub Test().

On ne touche pas à l'argument CheminNom ( voyez la procédure Test() ). On exécute simplement dans cotre code principal:

RefermerFichier MonClasseur

C'est la procédure RefermerFichier(...) qui se charge de tout (enlever le chemin du fichier et refermer le classeur).

Re

Oui, j'ai parlé trop vite.

Cela fonctionnait sur un fichier d'essai mais une fois intégré à mon "vrai" fichier, hélas non.

Mais en suivant vos conseils, c'est parfait.

Encore merci à vous pour votre aide précieuse.

Johann

 

[Yoyo60]

Bonjour
le code dans un module de essai1
est :
Option Explicit
Sub TestFichierOuvert()
Dim Verification As Boolean
Dim ClasseurFullName As String
Dim ClasseurShortName As String

ClasseurFullName = "D:\TEST\Essai2.xlsm"
ClasseurShortName = Split(ClasseurFullName, "\")(UBound(Split(ClasseurFullName, "\"))) 'Essai2.xlsm

'Test si Fichier Existant
If Len(Dir(ClasseurFullName)) = 0 Then 'Si pas existant, Avertissement et Fin de Macro
MsgBox "Le classeur n'existe pas ou à été déplacé, impossible de poursuivre.", vbCritical, "Erreur"
Exit Sub
Else
If EstClasseurOuvert(ClasseurShortName) = True Then
Workbooks(ClasseurShortName).Close SaveChanges:=False
Poursuite
Else
Poursuite
End If
End If
End Sub
Function EstClasseurOuvert(ClasseurShortName As String) As Boolean
Dim Wb As Workbook
On Error Resume Next
Set Wb = Workbooks(ClasseurShortName)
EstClasseurOuvert = (Not Wb Is Nothing)
End Function
Sub Poursuite()
MsgBox "poursuivre l'exécution de mes macros."
End Sub

Merci jm.andryszak

J'ai également testé votre code qui fonctionne parfaitement.

Merci également à vous pour le temps passé à me venir en aide.

Excellent week-end à vous.

Johann