Test d'ouverture de fichier

Olivier GUILLOT

XLDnaute Nouveau
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.
 

Lone-wolf

XLDnaute Barbatruc
Bonjour Olivier

VB:
Sub TestClasseurOuvert()
Dim EstOuvert As Boolean
Dim Classeur As String
Dim Chemin As String
Dim Wbk As Workbook

  Chemin = ThisWorkbook.Path & "\Classeur1.xlsx"
  Set Wbk = Workbooks.Open(Chemin)
  Classeur = ActiveWorkbook.FullName
  fichier = Right(Classeur, 14)

  'd'abord le test si le fichier existe
  If Len(Dir(Classeur)) = 0 Then  's'il n'existe pas, montrer un avertissement et quitter la macro
  MsgBox "ERREUR: Le Classeur: " & fichier & " n'existe pas..."
  Exit Sub
  Else
  End If

  'si le Classeur existe, vérifier s'il est déjà ouvert
  EstOuvert = ClasseurOuvert(Classeur)
  If EstOuvert = True Then
  MsgBox "Le Classeur: " & fichier & " est déjà ouvert..."
  Else
  MsgBox "Le Classeur: " & fichier & " n'est pas ouvert..."
  End If
End Sub


Function ClasseurOuvert(Classeur As String)
    Dim NumFile As Long, ErrNum As Long

    On Error Resume Next
    NumFile = FreeFile()
    Open Classeur For Input Lock Read As #NumFile
    Close NumFile
    ErrNum = Err
    On Error GoTo 0

    Select Case ErrNum
    Case 0: ClasseurOuvert = False
    Case 70: ClasseurOuvert = True
    Case Else: Error ErrNum
    End Select
End Function
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Bonjour Lone-wolf.
Je pense que j'écrirais une fonction renvoyant un objet Workbook, vu que c'est forcément pour travailler avec.
Quelque chose de ce genre :
VB:
Function Classeur(Optional ByVal ChNomF As String) As Workbook
Dim P As LongPtr
P = InStrRev(ChNomF, "\")
On Error Resume Next
Set Classeur = Workbooks(Mid$(ChNomF, P + 1)): If Err = 0 Then Exit Function
If P > 0 Then Err.Clear: Set Classeur = Workbooks.Open(ChNomF): If Err = 0 Then Exit Function
If ChNomF <> "" Then Exit Function
Set Classeur = Workbooks.Add
End Function
 

Dranreb

XLDnaute Barbatruc
VB:
Dim Wbk As WorkBook
Set Wbk = Classeur("Classeur1")
If Wbk Is Nothing …

Je la documente un peu de ce que j'espère de ses réactions :
VB:
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 de ce 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 LongPtr
P = InStrRev(ChNomF, "\")
On Error Resume Next
Set Classeur = Workbooks(Mid$(ChNomF, P + 1)): If Err = 0 Then Exit Function
If P > 0 Then Err.Clear: Set Classeur = Workbooks.Open(ChNomF): If Err = 0 Then Exit Function
If ChNomF <> "" Then Exit Function
Set Classeur = Workbooks.Add
End Function
À tester.
 
Dernière édition:

Olivier GUILLOT

XLDnaute Nouveau
Merci à tous les deux de votre aide.

En effet, le fichier classeur1 est déjà généré par une autre application et est censé être ouvert pour que ma macro fonctionne.

Il suffit juste que la macro vérifie que le fichier soit ouvert.

Cela fait il echo avec le post de Lone-Wolf sur le changement avec ActiveWorkbook.FullName : je ne vois donc pas ou il faut modifier cet ordre?

Pour info, je teste la macro posté initialement (et après quelques modif), cela fonctionne sauf que :
- si j'ouvre mon fichier contenant la macro a partir du fichier classeur1(qui n'a pas d'extension xl vu que le fichier n'est pas enregistré) : le message 1 s'affiche à tort
MsgBox "ERREUR: Le fichier : " & Fichier & " n'est pas ouvert ! Merci de le générer sous Quadratus."
mais le reste de la macro s'execute convenablement

voici ma macro modifiée :


Sub TestClasseurOuvert()
Dim EstOuvert As Boolean
Dim Classeur As String

Classeur = ThisWorkbook.Path & "\classeur1.xlsx" 'À adapter
Fichier = Right(Classeur, 14)

'd 'abord le test si le fichier existe
If Len(Dir(Classeur)) = 0 Then 's'il n'existe pas, montrer un avertissement et quitter la macro
MsgBox "ERREUR: Le fichier : " & Fichier & " n'est pas ouvert ! Merci de le générer sous Quadratus."

Exit Sub
Else
End If

'si le Classeur existe, vérifier s'il est déjà ouvert
EstOuvert = ClasseurOuvert(Classeur)
If EstOuvert = True Then
MsgBox "Le Classeur : " & Fichier & " est ouvert, Cliquez sur OK pour lancer la procédure d'enregistrement du fichier TXT"
Else
MsgBox "Le Classeur: " & Fichier & " n'est pas ouvert..."
End If
End Sub

Function ClasseurOuvert(Classeur As String)
Dim NumFile As Long, ErrNum As Long

On Error Resume Next
NumFile = FreeFile()
Open Classeur For Input Lock Read As #NumFile
Close NumFile
ErrNum = Err
On Error GoTo 0

Select Case ErrNum
Case 0: ClasseurOuvert = False
Case 70: ClasseurOuvert = True
' Case Else: Error ErrNum
End Select
End Function
 

Olivier GUILLOT

XLDnaute Nouveau
Pour complément d'info :
j'ai inséré une fonction de fermeture du fichier excel après afin de fermer d'office excel après le message d'alerte

Sub TestClasseurOuvert()
Dim EstOuvert As Boolean
Dim Classeur As String

Classeur = ThisWorkbook.Path & "\classeur1.xlsx" 'À adapter
' Classeur = ThisWorkbook.Path & "\classeur1" 'À adapter
Fichier = Right(Classeur, 14)

'd 'abord le test si le fichier existe
If Len(Dir(Classeur)) = 0 Then 's'il n'existe pas, montrer un avertissement et quitter la macro
MsgBox "ERREUR: Le fichier : " & Fichier & " n'est pas ouvert ! Merci de le générer sous Quadratus."
' Fermeture du fichier excel
' ThisWorkbook.Close SaveChanges:=False

Exit Sub
Else
End If

'si le Classeur existe, vérifier s'il est déjà ouvert
EstOuvert = ClasseurOuvert(Classeur)
If EstOuvert = True Then
MsgBox "Le Classeur : " & Fichier & " est ouvert, Cliquez sur OK pour lancer la procédure d'enregistrement du fichier TXT"
Else
MsgBox "Le Classeur: " & Fichier & " n'est pas ouvert..."
End If
End Sub

Function ClasseurOuvert(Classeur As String)
Dim NumFile As Long, ErrNum As Long

On Error Resume Next
NumFile = FreeFile()
Open Classeur For Input Lock Read As #NumFile
Close NumFile
ErrNum = Err
On Error GoTo 0

Select Case ErrNum
Case 0: ClasseurOuvert = False
Case 70: ClasseurOuvert = True
' Case Else: Error ErrNum
End Select
End Function
 

Lone-wolf

XLDnaute Barbatruc
Re Dranreb, Olivier

@Dranreb

Je ne c'est pas si c'est correct

VB:
Sub TestClasseurOuvert()
Dim Wbk As Workbook, fichier As Workbook, nom$

    Set fichier = Workbooks.Add
    nom = ActiveWorkbook.Name
    Set Wbk = Classeur(nom)

    If Wbk Is Nothing Then
        MsgBox "ERREUR: Workbooks" & "(""" & nom & """)" & "n'existe pas."
    Else
        MsgBox "Workbooks" & "(""" & nom & """)" & " est ouvert."
    End If
End Sub

Function Classeur(Optional ByVal ChNomF As String) As Workbook
Dim P As LongPtr
    P = InStrRev(ChNomF, "\")
    On Error Resume Next
    Set Classeur = Workbooks(Mid$(ChNomF, P + 1)): If Err = 0 Then Exit Function
    If P > 0 Then Err.Clear: Set Classeur = Workbooks.Open(ChNomF): If Err = 0 Then Exit Function
    If ChNomF <> "" Then Exit Function
    Set Classeur = Workbooks.Add
End Function

@Olivier GUILLOT : pourquoi fichier TXT alors que c'est un classeur?? :rolleyes:
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Le Workbook.Add tu l'as juste mis pour le test ?
Alors à priori l'appel de la fonction me semble correct.
Je ne saurais trop conseiller au demandeur d'utiliser dans sa macro l'objet Workbook renvoyé par cette fonction. Ce serait bête d'y laisser à tout bout de champ des expressions Workbooks("Classeur1.xlsx"), Wbk c'est quand même plus court.
 

Lone-wolf

XLDnaute Barbatruc
Re Dranreb

En mettant en commentaire Set fichier = Workbooks.Add, le message me donne le nom du classeur actif (ClasseurX.xlsm) en l'occurence.
Et normalement Workbooks.Add crée le nouveau classeur avec son nom par défaut.
 
Dernière édition:

Discussions similaires

Réponses
2
Affichages
236