Test d'ouverture de fichier

[Olivier GUILLOT]

Bonjour à tous,

Je souhaiterai écrire une macro VBA dans un fichier Excel test.xlsm à son ouverture :

- pour tester si le fichier Excel classeur1.xlsx est ouvert (ce fichier n'est pas encore enregistré sur le répertoire c
si oui => je continue le reste de ma macro déjà existante dans le fichier test.xlsm
si le fichier n'est pas ouvert => message d'alerte et fermeture de la macro et du fichier Excel test.xlsm

Je bute sur les macros car toutes les recherches sur le net présentent des commandes hyper compliquées.

Merci de votre aide.​

 

[Dranreb]

Il y a un P As LongPtr qui s'est glissé par erreur dans le Dim.
De toute façon je l'ai un peu remaniée :

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

 

[Lone-wolf]

Re Dranreb

@Dranreb

Nickel! Cette fois c'est OK!

EDIT: désolé, j'ai parlé trop vite. Ce n'est toujours pas bon, j'avais laissé workbooks.add dans ma Sub.

 

[Dranreb]

Attend ! J'envisage de permettre des "*" dans le nom de fichier…

 

[Olivier GUILLOT]

Désolé dans vos recherche, je ne cherche absolument pas à créer de fichier excel puisque celui ci est déjà crée en première étape.

Il s'agit seulement de verifier si le fichier classeur1 est ouvert. Si oui, la macro continue, si non, le fichier excel contenant la macro se ferme.

 

[Dranreb]

Mais qu'est-ce qui n'est pas bon ? La fonction classeur n'est pas faite principalement pour créer un classeur ni même l'ouvrir.
Elle permet juste de le faire en plus si on veut. La voici avec ce que je disais :

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

À tester

Pour la sous-employer en ne l'utilisant que pour vérifier si le classeur existe, faire :
If Classeur("Classeur1") Is Nothing Then
(Pour un classeur non enregistré)

 

[Lone-wolf]

Re Dranreb, Olivier

@Olivier GUILLOT

Une version plus courte.

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

 

[Lone-wolf]

Re

@Dranreb : encore une fois, si j'ai bien compris

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

 

[Dranreb]

Ben non, c'était l'inverse avant que tu ne rectifie, là c'est bon: Nothing c'est Rien !
C'est la valeur d'une expression objet non initialisée, et dans notre cas à laquelle on n'a pas pu affecter un objet Workbook représentant un classeur existant.

 

[Lone-wolf]

Re Dranreb

Ok. Je rectifie