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.
 

Roblochon

XLDnaute Accro
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...
 

Roblochon

XLDnaute Accro
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+
 

job75

XLDnaute Barbatruc
C'est juste ce que je viens de corriger.
Ah non, votre nouveau code n'est pas bon Roblochon car une fois que wk n'est pas Nothing il ne l'est plus jamais ensuite !

Il faut donc réinitialiser à chaque fois wk par Nothing.

C'est pour simplifier tout ça que j'ai créé la fonction IsClosed.
 

patricktoulon

XLDnaute Accro
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 Accro
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
;)
 

Roblochon

XLDnaute Accro
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 :)
 

Roblochon

XLDnaute Accro
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
 

Yoyo01000

XLDnaute Occasionnel
C'est parfait Roblochon, MERCI :)

Merci à vous tous, une fois de plus, qui aidez à merveille les gens comme moi dans le besoin :)
 

patricktoulon

XLDnaute Accro
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 ;)
 

Roblochon

XLDnaute Accro
Re,

@patricktoulon Chez moi, si j'ouvre deux instances excel avec deux fichiers différents GetObjet dans une instance peut obtenir le classeur de l'autre instance.

Et quand je parle de subtilités c'est parceque nous squattons là le fil du demandeur Yoyo01000 qui à mon avis n'en a rien à battre (ou presque) de nos débats stériles pour lui.
 
Dernière édition:

Yoyo01000

XLDnaute Occasionnel
Re,

@patricktoulon Chez moi, si j'ouvre deux instances excel avec deux fichiers différents GetObjet dans une instance peut obtenir le classeur de l'autre instance.

Et quand je parle de subtilités c'est parceque nous squattons là le fil du demandeur Yoyo01000 qui à mon avis n'en a rien à battre (ou presque) de nos débats stériles pour lui.
Re tout le monde ! Rien à battre je ne sais pas mais tout ce que je sais c'est que je ne comprends rien à vos échanges, par manque de connaissance ! Perso, ça ne me gêne pas si vous continuez à échanger sur votre sujet GetObject même si cela n'est pas courant et peut-être même si c'est contre la politique de ce forum !
Bonne journée à vous :)
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas