XL 2016 VBA non-ouverture fichier si déjà ouvert

Yoyo01000

XLDnaute Occasionnel
Bonjour le forum,

J'ai tenté, après avoir récupéré des bouts de code sur internet, de modifier mon code pour éviter d'avoir une fenêtre qui s'affiche lorsqu'un fichier est déjà ouvert mais en vain...

Voici ledit code dans un module et étant rattacher à un bouton :

VB:
'Workbooks.Open filename:= _
     "\\vcn.ds.volvo.net\rtc-bour\proj02\015443\02_Dossiers par UEP\UEP 5375 Pont&Essieu\00_Team Board\TL1 YD\ANDON 2019 TL1.xlsm" _
     , UpdateLinks:=3

Et voici le code dans son intégralité :

Code:
Sub Ouverture_Classeurs()
      
     Workbooks.Open filename:= _
     "\\vcn.ds.volvo.net\rtc-bour\proj02\015443\02_Dossiers par UEP\UEP 5375 Pont&Essieu\00_Team Board\TL1 YD\ANDON 2019 TL1.xlsm" _
     , UpdateLinks:=3 'Mise à jour des liens au démarrage de ce même classeur
          
     Workbooks.Open filename:= _
     "\\vcn.ds.volvo.net\rtc-bour\proj02\028319\01_INDICATEUR\PAD\saisie PAD L2 2019.xlsx" _
     , Notify:=True, ReadOnly:=True, UpdateLinks:=0
        
     Workbooks.Open filename:= _
     "\\vcn.ds.volvo.net\rtc-bour\proj01\014799\2019\Fichier de saisie arret L2.xlsm"
            
     Workbooks.Open "\\vcn.ds.volvo.net\rtc-bour\proj02\028319\01_INDICATEUR\DEMERITE\démérite 2019.xlsx" _
     , ReadOnly:=True, UpdateLinks:=0 'Lecture seule, Ne fais pas le téléchargement des liens
    
     Workbooks("Suivi des résultats TL1.xlsm").Activate
    
     End Sub

J'espère que le simple fait de mettre que le code et non le fichier sera suffisant !? (Fichier avec données personnelles)

Par avance merci pour votre aide.
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Voici une fonction qui pourra vous aider:

Exemple d'utilisation:

Dim Wk as workbook
set Wk = GetWorkBookByName("LeClasseur.xlsx","G:\toto\tata\tonton",True)

Renverra le classeur "LeClasseur.xlsx" s'il est ouvert sinon tentera de l'ouvrir au chemin indiqué puis le renverra

VB:
Function GetWorkbookByName(ByVal WorkbookName As String, Optional ByVal Path As String, Optional ByVal OpenIfNotExists As Boolean = True) As Workbook
    On Error Resume Next
    Set GetWorkbookByName = Workbooks(WorkbookName)
    If Err.Number = 9 And OpenIfNotExists Then
        If Path = "" Then Path = ThisWorkbook.Path
        If Right(Path, 1) <> Application.PathSeparator Then Path = Path & Application.PathSeparator
        Set GetWorkbookByName = Workbooks.Open(Path & WorkbookName)
    End If
End Function

Bonne continuation
 
Dernière édition:

Yoyo01000

XLDnaute Occasionnel
Bonjour,

Voici une fonction qui pourra vous aider:

Exemple d'utilisation:

Dim Wk as workbook
set Wk = GetWorkBookByName("LeClasseur.xlsx","G:\toto\tata\tonton",True)

Renverra le classeur "LeClasseur.xlsx" s'il est ouvert sinon tentera de l'ouvrir au chemin indiqué puis le renverra

VB:
Function GetWorkbookByName(ByVal WorkbookName As String, Optional ByVal Path As String, Optional ByVal OpenIfNotExists As Boolean = True) As Workbook
    On Error Resume Next
    Set GetWorkbookByName = Workbooks(WorkbookName)
    If Err.Number = 9 And OpenIfNotExists Then
        If Path = "" Then Path = ThisWorkbook.Path
        If Right(Path, 1) <> Application.PathSeparator Then Path = Path & Application.PathSeparator
        Set GetWorkbookByName = Workbooks.Open(Path & WorkbookName)
    End If
End Function
End Function

Bonne continuation

Je ne sais pas où mettre précisément votre code, j'ai essayé à plusieurs endroits mais rien n'y fait.

J'ai toujours une fenêtre qui me dit que le fichier est déjà ouvert.

Désolé, je manque de compétences en matière VBA...
 

Hasco

XLDnaute Barbatruc
Repose en paix
Re,

Alors le plus simple c'est d'essayer ceci:
VB:
Sub Ouverture_Classeurs()
    Dim wk As Workbook

    On Error Resume Next

    ' Teste si fichier ouvert
    Set wk = Workbooks("ANDON 2019 TL1.xlsm")
    '
    ' sinon ouvre fichier
    If wk Is Nothing Then
        Workbooks.Open Filename:= _
                       "\\vcn.ds.volvo.net\rtc-bour\proj02\015443\02_Dossiers par UEP\UEP 5375 Pont&Essieu\00_Team Board\TL1 YD\ANDON 2019 TL1.xlsm" _
                     , UpdateLinks:=3    'Mise à jour des liens au démarrage de ce même classeur
    End If
    '
    ' fichier suivant
     Set wk = nothing
    Set wk = Workbooks("saisie PAD L2 2019.xlsx")
    If wk Is Nothing Then
        Workbooks.Open Filename:= _
                       "\\vcn.ds.volvo.net\rtc-bour\proj02\028319\01_INDICATEUR\PAD\saisie PAD L2 2019.xlsx" _
                     , Notify:=True, ReadOnly:=True, UpdateLinks:=0
    End If
    '
    ' fichier suivant
    Set wk = nothing
    Set wk = Workbooks("Fichier de saisie arret L2.xlsm")
    If wk Is Nothing Then
        Workbooks.Open Filename:= _
                       "\\vcn.ds.volvo.net\rtc-bour\proj01\014799\2019\Fichier de saisie arret L2.xlsm"
    End If
    '
    ' fichier suivant
     set wk = nothing
    Set wk = Workbooks("démérite 2019.xlsx")
    If wk Is Nothing Then
        Workbooks.Open "\\vcn.ds.volvo.net\rtc-bour\proj02\028319\01_INDICATEUR\DEMERITE\démérite 2019.xlsx" _
                     , ReadOnly:=True, UpdateLinks:=0    'Lecture seule, Ne fais pas le téléchargement des liens

    End If
    On Error GoTo 0
    Workbooks("Suivi des résultats TL1.xlsm").Activate

End Sub

Bonne soirée
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour Yoyo01000, Roblochon,
Alors le plus simple c'est d'essayer ceci:
D'accord mais là il n'y aura plus de message si l'un des fichiers n'est pas trouvé.

Et si un fichier a été modifié les modifications seront perdues.

Je suggère plutôt ce code :
VB:
Function IsClosed(fichier$)
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(fichier)
IsClosed = wb Is Nothing
End Function

Sub Ouverture_Classeurs()

If IsClosed("ANDON 2019 TL1.xlsm") Then
    Workbooks.Open Filename:= _
    "\\vcn.ds.volvo.net\rtc-bour\proj02\015443\02_Dossiers par UEP\UEP 5375 Pont&Essieu\00_Team Board\TL1 YD\ANDON 2019 TL1.xlsm" _
    , UpdateLinks:=3 'Mise à jour des liens au démarrage de ce même classeur
End If

If IsClosed("saisie PAD L2 2019.xlsx") Then
    Workbooks.Open Filename:= _
    "\\vcn.ds.volvo.net\rtc-bour\proj02\028319\01_INDICATEUR\PAD\saisie PAD L2 2019.xlsx" _
    , Notify:=True, ReadOnly:=True, UpdateLinks:=0
End If

If IsClosed("Fichier de saisie arret L2.xlsm") Then
    Workbooks.Open Filename:= _
    "\\vcn.ds.volvo.net\rtc-bour\proj01\014799\2019\Fichier de saisie arret L2.xlsm"
End If

If IsClosed("démérite 2019.xlsx") Then
    Workbooks.Open "\\vcn.ds.volvo.net\rtc-bour\proj02\028319\01_INDICATEUR\DEMERITE\démérite 2019.xlsx" _
    , ReadOnly:=True, UpdateLinks:=0 'Lecture seule, Ne fais pas le téléchargement des liens
End If

Workbooks("Suivi des résultats TL1.xlsm").Activate

End Sub
A+
 

patricktoulon

XLDnaute Barbatruc
bonsoir
je pense que vous avez oublié un détail important tout de même
ceci
VB:
 Set wk = Workbooks("ANDON 2019 TL1.xlsm")
    '
    ' sinon ouvre fichier
    If wk Is Nothing Then
fonctionnera dans l'instance de l'application ou se trouve le fichier de cette macro et si le fichier cible y est ou pas

mais si la cible est ouvert dans une autre instance ben Wk renverra toujours nothing c'est garanti !!
 

patricktoulon

XLDnaute Barbatruc
re
sinon je vous propose ceci
qui tente d'ouvrir EN MEMOIRE avec open for Input Lock Read et la réponse est claire que le classeur soit ouvert dans l'instance de excel parent du fichier macro ou non

VB:
Sub test()
    MsgBox estOuvert("C:\Users\polux\DeskTop\translate interface.xlsm")
End Sub
Function estOuvert(fichier As String)
    Dim x As Integer, E As Integer
    x = FreeFile()
    estOuvert = False
    On Error Resume Next
    Open fichier For Input Lock Read As #x
    Close x
    E = Err
    On Error GoTo 0
    Select Case E
    Case 0: estOuvert = False
    Case 70: estOuvert = True
    Case Else: estOuvert = E
    End Select

End Function

;)
 

Hasco

XLDnaute Barbatruc
Repose en paix
Re,

Je ne sais si ce genre de subtilité est nécessaire au demandeur, aussi je me contenterai de répondre que GetObject pourrait suivant le besoin tout aussi bien faire le job.

Bonne journée
 
Dernière édition:

Yoyo01000

XLDnaute Occasionnel
Bonjour à tous et désolé de ne répondre seulement maintenant mais j'ai été bien occupé !

J'ai, au final, pris le code de job75 qui est non seulement le plus explicite pour moi d'une part et d'une autre, d'après tous les commentaires, le plus adapté à mon besoin :)

Je vous remercie tous pour le temps que vous avez passé sur mon sujet :)

Il me reste cependant une question :

Comment procéder pour le cas inverse ?
J'entends par là un code me permettant de fermer tous les fichiers ouverts avec le précédent code même si ou plusieurs de ces fichiers est ou sont déjà fermé(s).

Voici le premier code que j'ai écrit mais qui ne peut fonctionner si l'un des fichiers est déjà fermé :

VB:
Sub Fermeture_Classeurs()
    
   Workbooks("ANDON 2019 TL1.xlsm").Close SaveChanges:=True

   Workbooks("saisie PAD L2 2019.xlsx").Close savechanges:=False
      
   Workbooks("Fichier de saisie arret L2.xlsm").Close savechanges:=False
    
   Workbooks("démérite 2019.xlsx").Close savechanges:=False
    
   End Sub

Et le code que j'ai essayé qui permet de fermer les fichiers même si un ou plusieurs d'entre eux est ou sont déjà fermé(s) :

VB:
Function IsOpen(fichier$)
     Dim wb As Workbook
     On Error Resume Next
     Set wb = Workbooks(fichier)
     IsOpen = wb Is Nothing
End Function

Private Sub Workbook_BeforeClose(Cancel As Boolean)

     If IsOpen("ANDON 2019 TL1.xlsm") Then
     Workbooks("ANDON 2019 TL1.xlsm").Close savechanges:=False
     End If

End Sub

Je me suis permis ce nouveau sujet sur le précédent alors n'hésitez pas à me dire si je dois ouvrir un nouveau post :)
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Soit vous inverser le test dans IsOpen:
IsOpen = Not wb Is Nothing

Soit vous utilisez IsClosed (fonction que vous avez déjà) et

VB:
Private Sub Workbook_BeforeClose(Cancel As Boolean)

     If Not IsClosed("ANDON 2019 TL1.xlsm") Then
     Workbooks("ANDON 2019 TL1.xlsm").Close savechanges:=False
     End If

End Sub

Cordialement
 

patricktoulon

XLDnaute Barbatruc
Re,

Je ne sais si ce genre de subtilité est nécessaire au demandeur, aussi je me contenterai de répondre que GetObject pourrait suivant le besoin tout aussi bien faire le job.

Bonne journée
Bonjour Roblochon
c'est pas une subtilité chez moi par exemple ,ayant deux versions coexistantes d'excel (2007/2013) les fichiers ne s'ouvrent plus dans la même instance quand je l'es ouvre par leur icons
quand a getobject bonnet blanc blanc bonnet : ne travaille que dans l'instance sauf en VBS visiblement ,si je me souviens bien ;)
 

Statistiques des forums

Discussions
311 737
Messages
2 082 036
Membres
101 878
dernier inscrit
1475214