'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
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
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
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
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
D'accord mais là il n'y aura plus de message si l'un des fichiers n'est pas trouvé.Alors le plus simple c'est d'essayer ceci:
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
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 !C'est juste ce que je viens de corriger.
Set wk = Workbooks("ANDON 2019 TL1.xlsm")
'
' sinon ouvre fichier
If wk Is Nothing Then
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
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
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
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
Bonjour RoblochonRe,
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