Test d'ouverture de fichier

Function Classeur(Optional ByVal ChNomF As String) As Workbook
Rem. — Cherche et renvoie si possible un objet Workbook
'  ChNomF: Identification facultative du classeur.
'     Si elle est vide ou non spécifiée: renvoie un nouveau classeur.
'     Si elle ne comporte pas de "\", cherche un classeur ouvert du seul nom spécifié.
'     Si elle en comporte, cherche un classeur ouvert du nom donné par ce qui suit le
'        dernier "\", et s'il n'y en a pas, tente de l'ouvrir.
Dim P As Long, NomFic As String
P = InStrRev(ChNomF, "\"): NomFic = Mid$(ChNomF, P + 1)
If NomFic = "" Then Set Classeur = Workbooks.Add: Exit Function
On Error Resume Next
Set Classeur = Workbooks(NomFic): If Err = 0 Or P = 0 Then Exit Function
Set Classeur = Workbooks.Open(ChNomF)
End Function

Function Classeur(Optional ByVal ChNomF As String) As Workbook
Rem. — Cherche et renvoie si possible un objet Workbook
'  ChNomF: Identification facultative du classeur.
'     Si elle est vide ou non spécifiée: renvoie un nouveau classeur.
'     Si elle ne comporte pas de "\", cherche un classeur ouvert du seul nom spécifié.
'     Si elle en comporte, cherche un classeur ouvert du nom donné par ce qui suit le
'        dernier "\", et s'il n'y en a pas, tente de l'ouvrir.
'  Remarque: Le caractère générique "*" est accepté dans le nom du fichier.
Dim P As Long, NomFic As String
P = InStrRev(ChNomF, "\"): NomFic = Mid$(ChNomF, P + 1)
If NomFic = "" Then Set Classeur = Workbooks.Add: Exit Function
On Error Resume Next
If InStr(NomFic, "*") > 0 Then
   For Each Classeur In Workbooks
      If Classeur.Name Like NomFic Then Exit Function
      Next Classeur
   Set Classeur = Nothing: If P = 0 Then Exit Function
   NomFic = Dir(ChNomF): If NomFic = "" Then Exit Function
   Set Classeur = Workbooks.Open(Left$(ChNomF, P) & NomFic)
Else
   Set Classeur = Workbooks(NomFic): If Err = 0 Or P = 0 Then Exit Function
   Set Classeur = Workbooks.Open(ChNomF): End If
End Function

Sub TestClasseurOuvert()
Dim Chemin$, Fichier$, Wks As Workbook

    Application.ScreenUpdating = False
   
    Chemin = ThisWorkbook.Path & "\Classeur2.xlsx"
    Fichier = Mid(Chemin, InStrRev(Chemin, "\") + 1)   'Nom du classeur

    'On test, pour commencer, si le fichier existe
    If Dir(Chemin) <> "" Then
        MsgBox "Le fichier " & Fichier & " existe"
    Else
        'S'il n'existe pas, on affiche un avertissement et on crée le classeur
        MsgBox "Le fichier " & Fichier & " n'existe pas.", vbCritical, "ERREUR"
        Set Wks = Workbooks.Add
        Wks.SaveAs Chemin
        ActiveWorkbook.Close True
        MsgBox "Le fichier " & Fichier & " a été créé.", vbInformation, "SUCCESS"
        Exit Sub
    End If

    'Ensuite on vérifie si il est ouvert
    If FichOuvert(Fichier) Then
        MsgBox "Le fichier " & Fichier & " est ouvert."
    Else
        MsgBox "Le fichier " & Fichier & " n'est pas ouvert."
    End If

End Sub

Function FichOuvert(F As String) As Boolean
    On Error Resume Next
    FichOuvert = Not Workbooks(F) Is Nothing
End Function

Sub test()
If Classeur("Classeur1") Is Nothing Then
MsgBox "Workbooks Not Exist"
Else
MsgBox "Workbooks Exist"
End If
End Sub