Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function CheminMisCourant Lib "kernel32" _
Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
#Else
Private Declare Function CheminMisCourant Lib "kernel32" _
Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
#End If
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: l'objet retourné représentera 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 du dossier spécifié devant.
' Remarques:
' Adresses de domaines et chemins relatifs au dossier courant sont acceptés.
' Le caractère générique "*" est accepté dans le nom du fichier.
Dim P As Long, Dossier As String, NomFic As String, RésuDir As String
If ChNomF = "" Then Set Classeur = Workbooks.Add: Exit Function
P = InStrRev(ChNomF, "\"): Dossier = Left$(ChNomF, P - 1): NomFic = Mid$(ChNomF, P + 1)
If InStr(NomFic, ".") = 0 Then NomFic = NomFic & ".xl*"
If InStr(NomFic, "*") > 0 Then
For Each Classeur In Workbooks: If Classeur.Name Like NomFic Then Exit For
Next Classeur
Else
On Error Resume Next: Set Classeur = Workbooks(NomFic): On Error GoTo 0: End If
If P > 0 Then
If Dossier <> "" Then If CheminMisCourant(Dossier) = 0 Then _
MsgBox "Impossible d'ouvrir le dossier suivant :" _
& vbLf & Dossier, vbCritical, "Classeur": Exit Function
If Classeur Is Nothing Then
RésuDir = Dir(NomFic): If RésuDir = "" Then MsgBox "Aucun classeur """ & NomFic _
& """ trouvé sur :" & vbLf & CurDir, vbCritical, "Classeur": Exit Function
Set Classeur = Workbooks.Open(RésuDir)
ElseIf Classeur.Path <> CurDir Then
MsgBox "Il a bien été trouvé un classeur """ & Classeur.Name & """ ouvert," _
& vbLf & "mais son chemin est le suivant :" & vbLf & Classeur.Path _
& vbLf & "et non pas celui ci :" _
& vbLf & CurDir, vbExclamation, "Classeur"
End If
ElseIf Classeur Is Nothing Then
MsgBox "Aucun classeur """ & NomFic & """ n'est ouvert.", vbCritical, "Classeur"
End If
End Function
Sub ExempleDUtilisation()
Dim Wbk As Workbook
Set Wbk = Classeur("\\nas\Dossier1\Dossier2\2. Excel\ASP - Fichier V*.*.xlsm")
If Wbk Is Nothing Then Exit Sub