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

Yoyo01000 · 30 Septembre 2019

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 · 30 Septembre 2019

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

Yoyo01000 · 30 Septembre 2019

Roblochon à dit:
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 · 30 Septembre 2019

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

job75 · 30 Septembre 2019

Bonjour Yoyo01000, Roblochon,

Roblochon à dit:
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+

Hasco · 30 Septembre 2019

Re,

C'est juste ce que je viens de corriger.

A+

job75 · 30 Septembre 2019

Roblochon à dit:
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.

Hasco · 30 Septembre 2019

Re,

C'est juste et corrigé.

patricktoulon · 30 Septembre 2019

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 · 30 Septembre 2019

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 · 1 Octobre 2019

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

Yoyo01000 · 3 Octobre 2019

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 · 3 Octobre 2019

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 · 3 Octobre 2019

C'est parfait Roblochon, MERCI

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

patricktoulon · 3 Octobre 2019

Roblochon à dit:
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

Effectuez une recherche sur Excel Downloads...

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

Yoyo01000

XLDnaute Occasionnel

Hasco

XLDnaute Barbatruc

Yoyo01000

XLDnaute Occasionnel

Hasco

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Hasco

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Hasco

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Hasco

XLDnaute Barbatruc

Yoyo01000

XLDnaute Occasionnel

Hasco

XLDnaute Barbatruc

Yoyo01000

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums