Microsoft 365 Eviter bug sur fichier déjà ouvert

pompaero

XLDnaute Impliqué
Bonjour le forum,

j'essai de créer un tableau de manière à pouvoir à l'aide de bouton ouvrir les documents utile quotidiennement pour mon travail.
Exemple : sur le tableau de bord se trouve un bouton,
- Fichier A qui ouvre le fichier A
- Fichier B qui ouvre le fichier B
et autres fichiers encore.
J'aimerai résoudre un petit soucis qui provoque un bug.
Dans le fichier A, une fois ouvert si je le souhaite, je peux revenir sur le tableau de bord, cela fonctionne si le tableau de bord est fermé mais si celui-ci est déjà ouvert cela provoque un bug que j'aimerai éviter.
Voici le code que j'ai en place dans le Fichier A, comment pourrait-on résoudre cela ?
VB:
Sub OpenTableaudeBord()
'Ouverture tableau de bord
  ChDir "T:\AEROPORT\SSLIA\Admin_SSLIA-SPPA\Z-Appli par mdp\Application"
  Workbooks.Open Filename:="T:\AEROPORT\SSLIA\Admin_SSLIA-SPPA\Z-Appli par mdp\Application\TABLEAU DE BORD.xlsm"
End Sub
Merci par avance de votre soutien et aide.

Cdlm
pompaero
 
Solution
Bonjour Pompaero, kiki29, le forum

Voici une fonction pour tester si ton classeur est ouvert
VB:
Function Fichier_Ouvert(ByVal NomFichier$) As Boolean
    Dim Test_Objet As Workbook
    On Error GoTo Gere_Erreurs
    Set Test_Objet = Workbooks(NomFichier)
    Fichier_Ouvert = True
    Set Test_Objet = Nothing
Gere_Erreurs:
    On Error GoTo 0
End Function
à utiliser comme cela
Code:
Sub OpenTableaudeBord()
'Ouverture tableau de bord
  ChDir "T:\AEROPORT\SSLIA\Admin_SSLIA-SPPA\Z-Appli par mdp\Application"
  If Fichier_Ouvert("TABLEAU DE BORD.xlsm") Then
    Workbooks("TABLEAU DE BORD.xlsm").Activate
    Else
    Workbooks.Open Filename:="T:\AEROPORT\SSLIA\Admin_SSLIA-SPPA\Z-Appli par mdp\Application\TABLEAU DE BORD.xlsm"
    End If
End...
Bonjour Pompaero, kiki29, le forum

Voici une fonction pour tester si ton classeur est ouvert
VB:
Function Fichier_Ouvert(ByVal NomFichier$) As Boolean
    Dim Test_Objet As Workbook
    On Error GoTo Gere_Erreurs
    Set Test_Objet = Workbooks(NomFichier)
    Fichier_Ouvert = True
    Set Test_Objet = Nothing
Gere_Erreurs:
    On Error GoTo 0
End Function
à utiliser comme cela
Code:
Sub OpenTableaudeBord()
'Ouverture tableau de bord
  ChDir "T:\AEROPORT\SSLIA\Admin_SSLIA-SPPA\Z-Appli par mdp\Application"
  If Fichier_Ouvert("TABLEAU DE BORD.xlsm") Then
    Workbooks("TABLEAU DE BORD.xlsm").Activate
    Else
    Workbooks.Open Filename:="T:\AEROPORT\SSLIA\Admin_SSLIA-SPPA\Z-Appli par mdp\Application\TABLEAU DE BORD.xlsm"
    End If
End Sub
sinon un simple "on error resume next" avant ton open et un "on error goto 0" après devrait suffire.

Bien cordialement
 

pompaero

XLDnaute Impliqué
Bonsoir kiki29, Yeahou,

Merci de votre retour, c'est cool, grâce à vous j'avance bien dans mon projet.
Vos deux solutions fonctionnent super bien mais pour la présentation que je souhaite, j'adhère plus sur la proposition de Yeahou.
Désolé pour kiki29.

Merci encore, bonne soirée.
Cdlt
pompaero
 

kiki29

XLDnaute Barbatruc
Re, une version "light" :
VB:
Private Function IsFileOpenLight(filename As String) As Boolean
Dim fichier As Integer
    On Error Resume Next

    fichier = FreeFile()
    Open filename For Input Access Read Lock Read Write As fichier

    If Err.Number = 0 Then
        IsFileOpenLight = False
        Close fichier
    Else
        IsFileOpenLight = True
    End If
End Function
 
Bonjour Pompaero, kiki29, le forum

Re, une version "light" :
kiki29, je ne vois pas ce qu'un accès disque et une fermeture/réouverture de fichier a de plus light qu'un référencement et une ouverture si besoin.
pour du light, ceci fonctionnera aussi bien mais c'est moins propre

Bien cordialement
VB:
Function Fichier_Ouvert(ByVal NomFichier$) As Boolean
    On Error GoTo Gere_Erreurs
    Set Test_Objet = Workbooks(NomFichier)
    Fichier_Ouvert = True
Gere_Erreurs:
End Function
 

kiki29

XLDnaute Barbatruc
Salut, je parlais de la version fournie ici et non de la tienne dont je n'ai que faire.
Elle est surtout générique.
VB:
Option Explicit

Sub Tst()
    'TestIsFileOpen "C:\.....\Supprimer fichiers ~$ APIs.xlsb"
    'TestIsFileOpen "C:\.....\Fusion.pdf"
    TestIsFileOpen "C::\.....\ImageDePlage.jpg"
End Sub

Private Sub TestIsFileOpen(sFichier As String)
    If IsFileOpenLight(sFichier) Then
        MsgBox "Fichier déjà ouvert !"
    Else
        MsgBox "Fichier non utilisé !"
    End If
End Sub

Private Function IsFileOpenLight(filename As String) As Boolean
Dim fichier As Integer
    On Error Resume Next

    fichier = FreeFile()
    Open filename For Input Access Read Lock Read Write As fichier

    If Err.Number = 0 Then
        IsFileOpenLight = False
        Close fichier
    Else
        IsFileOpenLight = True
    End If
End Function
 
Dernière édition:

Discussions similaires

Réponses
16
Affichages
986

Statistiques des forums

Discussions
315 094
Messages
2 116 155
Membres
112 671
dernier inscrit
Sylvain14