Forums XLPages

Excel & VBA Forum principal [résolu] Comment tester si un fichier excel est déjà ouvert dans une macro

Comment tester si un fichier excel est déjà ouvert dans une macro
#1
Basket
Débutant XLPages

Inscription: 10/02/2011

Messages: 9

Système d'exploitation:
PC
Version Excel utilisée:
2003
Posté le : 10-02-2011 15h21
Je mets à jour un fichier excel à partir d'autres fichiers excel. Avant d'ouvrir les autres fichiers, je cherche à tester si le fichier est déjà ouvert
Hors Ligne
 Rapport   Haut 

Re: Comment tester si un fichier excel est déjà ouvert dans une macro
#2
myDearFriend!
Webmestre

Inscription: 18/05/2006
De Saône-et-Loire (71)

Messages: 1539

Système d'exploitation:
PC
Version Excel utilisée:
97, 2000, 2002, 2003, 2007, 2010, 2013, 2016 et 365
Posté le : 10-02-2011 23h27
Citation :
Basket a écrit :
Je mets à jour un fichier excel à partir d'autres fichiers excel. Avant d'ouvrir les autres fichiers, je cherche à tester si le fichier est déjà ouvert
Eh bien moi, je dis « Bonjour » quand j'arrive quelque part et je ne demande pas de l'aide dans un forum de bénévoles comme je le ferais auprès d'une hotline !

Bonne continuation.

Didier_mDF
Image redimensionnée
Le Webmaster

La réponse vous satisfait ? Merci de revenir solder le sujet en [résolu], voir ce lien
Hors Ligne
 Rapport   Haut 

Re: Comment tester si un fichier excel est déjà ouvert dans une macro
#3
Guy
Accro XLPages

Inscription: 09/01/2008
De Montréal, Québec

Messages: 463

Système d'exploitation:
PC
Version Excel utilisée:
97 à 2016
Posté le : 12-02-2011 00h21
Bonjour Didier, le forum, basket,

Il est vrai que la bienséance aurait commandé une permutation des salutations mais je m’en voudrais de ne pas souligner l’à-propos de la remarque de Didier. Ceci dit, poursuivons.

Il y a bien évidemment trente-six façons de procéder. En voici une.

Dans un module de code copier le bout de code suivant :

Option Explicit

Dim objExcel As Excel.Application

'---------------------------------------------------------------------------------------
' Procédure : ClasseurEstOuvert
' Auteur    : 2pme, Guy Courville
' Date      : vendredi 11 février 2011
' Détails   : Le jeu consiste à ouvrir le classeur dans une instance invisible d'Excel
'             et à tester la propriété ReadOnly de ce classeur. C'est la valeur de cette
'             propriété qui est retournée par la fonction.
'
' Note 1    : Le paramètre strNomFichierComplet doit porter le chemin complet du classeur
'             comme son nom l'indique.
'
' Note 2    : Aucun gestionnaire d'erreur n'est actif.
'
'---------------------------------------------------------------------------------------
'
Function ClasseurEstOuvert(strNomFichierComplet As String) As Boolean

  Set objExcel = New Excel.Application
 
  With objExcel
 
    ' L'instance d'Excel qui porte le fichier ne doit pas être visible
    .Visible = False
   
    .Workbooks.Open (strNomFichierComplet)
   
    ' Si le classeur est déjà ouvert cette propriété sera à True
    ClasseurEstOuvert = .Workbooks(1).ReadOnly
 
    .Quit
 
  End With
 
  ' Ne pas oublier de supprimer la référence à Excel
  ' sinon une autre instance fantôme hantera votre système...
  Set objExcel = Nothing
 
End Function
 

Le temps d'exécution est assez important (un peu moins de deux secondes sur mon poste) puisqu'une nouvelle instance d'Excel est créée. Cette lenteur, toute relative, ne devrais pas gêner outre mesure je crois.

Cordialement,

Guy

Édition : Dans ce qui précède on suppose que le classeur n'est pas en mode lecture seule à dessein...

Edité par Guy le 12/02/2011 00:46:53
Image redimensionnée

2pme
Hors Ligne
 Rapport   Haut 

Re: Comment tester si un fichier excel est déjà ouvert dans une macro
#4
Basket
Débutant XLPages

Inscription: 10/02/2011

Messages: 9

Système d'exploitation:
PC
Version Excel utilisée:
2003
Posté le : 14-02-2011 17h12
Il est vrai, j'aurais dû dire bonjour avant de poser ma question, je m'en excuse....la prochaine fois je ferai plus attention...  pour autant, j'ai découvert le site et je le trouve très bien
Hors Ligne
 Rapport   Haut 

Re: Comment tester si un fichier excel est déjà ouvert dans une macro
#5
Guy
Accro XLPages

Inscription: 09/01/2008
De Montréal, Québec

Messages: 463

Système d'exploitation:
PC
Version Excel utilisée:
97 à 2016
Posté le : 14-02-2011 23h01
Bonjour Basket,

Et mis à part ces bonjours de circonstance est-ce que la fonction de mon message précédent fait l'affaire?
Est-ce que tu arrives à t'en servir?
As-tu besoin d'autres précisions?

Cordialement,

Guy
Image redimensionnée

2pme
Hors Ligne
 Rapport   Haut 

Re: Comment tester si un fichier excel est déjà ouvert dans une macro
#6
Basket
Débutant XLPages

Inscription: 10/02/2011

Messages: 9

Système d'exploitation:
PC
Version Excel utilisée:
2003
Posté le : 15-02-2011 14h58
Bonjour Guy,

J'ai testé ta procédure sur laquelle j'ai eu quelques soucis, je ne suis pas arrivé à y mettre Option Explicit et Dim objExcel As Excel.Application
N'étant pas un pro de VBA, j'ai quand même réussi à insérer ton code dans le mien  sans ces "option et Dim" et ça marche finement. De ce que je comprends de ta procédure, c'est que tu ouvres le fichier dans un excel non visible, le fait de tester qu'il soit readonly fait que le fichier est déjà ouvert, c'est bien ça ?.

Merci de ton aide

Cordialement

Olivier 
Hors Ligne
 Rapport   Haut 

Re: Comment tester si un fichier excel est déjà ouvert dans une macro
#7
michel_m
Débutant XLPages

Inscription: 05/07/2007
De Aubenas(07)

Messages: 9

Système d'exploitation:
PC
Version Excel utilisée:
2000
Posté le : 15-02-2011 18h03
Bonjour
Je ne résiste au plaisir de montrer cette fonction écrite par Didier dans sa jeunesse
Function FichOuvert(F As String) As Boolean
'Auteur: Didier_mdf  sur forum www.Excel-downloads.com (merci)
Dim Wk As Workbook
On Error Resume Next
Set Wk = Workbooks(F)
On Error GoTo 0
FichOuvert = Not Wk Is Nothing
End Function



Amicalement
Michel_M
Hors Ligne
 Rapport   Haut 

Re: Comment tester si un fichier excel est déjà ouvert dans une macro
#8
Guy
Accro XLPages

Inscription: 09/01/2008
De Montréal, Québec

Messages: 463

Système d'exploitation:
PC
Version Excel utilisée:
97 à 2016
Posté le : 15-02-2011 23h35
Bonjour Michel_m, Basket, Didier, le forum,

Précisions :

Effectivement la fonction citée teste l'ouverture du classeur passé en argument mais dans l'instance actuelle (où s'exécute le code) d'Excel. En d'autres termes cette fonction informe sur la présence du classeur F dans la collection des classeurs de l'instance (Workbooks) cependant il est tout à fait possible que le classeur F soit ouvert dans une autre instance d'Excel auquel cas la fonction retourne Faux pour l'instance actuelle alors que le classeur est effectivement (Vrai) ouvert ailleurs.

Voilà pourquoi dans le bout de code fourni le test s'effectue sur une nouvelle instance d'Excel pour assurer un test sur l'ensemble du poste (system wide).

Pour répondre à la note de Basket qui n'arrive pas à faire rouler le bout de code soumis deux choses:
  1. Il est fortement indiqué de poser Option Explicit dans l'en-tête de tous les modules et que le code une fois copié n'ait pas fonctionné indique que des variables ont été déclarées à la volée... malsain et contre-indiqué (plus là-dessus sur demande).
  2. Citation :
    sans ces"option et Dim" et ça marche finement
    justement! C'est que ça marche sur une béquille. Il serait indiqué de fournir un classeur portant le code qu'on y jette un oeil attentif.

Cordialemement,

Guy






Edité par Guy le 16/02/2011 02:04:30
Image redimensionnée

2pme
Hors Ligne
 Rapport   Haut 

Re: Comment tester si un fichier excel est déjà ouvert dans une macro
#9
Basket
Débutant XLPages

Inscription: 10/02/2011

Messages: 9

Système d'exploitation:
PC
Version Excel utilisée:
2003
Posté le : 16-02-2011 09h16
Sub Maj_donnees()
'
' Maj_donnees Macro
' Macro enregistrée le 28/12/2010 par Olivier
'
' Touche de raccourci du clavier: Ctrl+j
'
   
'   Ouverture du fichier ci-dessous avec le no du fichier en paramètre récupéré
'   en cellule G2
'   fic = "\\naoned\sous-traitant\AdjustHR\03 - Fiche navette\FN 018\Suivi Fiche 018"
   
    Dim fic1 As String
    Dim fic2 As String
    Dim fic3 As String
    Dim fic4 As String
    Dim fic5 As String
    Dim fic  As String
    fic1 = "\\naoned\sous-traitant\AdjustHR\03 - Fiche navette\FN "
    fic2 = "Suivi Fiche "
    fic3 = "0"
    fic33 = "00"
    fic4 = "='[Suivi Fiche "
    fic5 = ".xls]Besoin'!"
    fic6 = ".xls"
    DATED = "R1C5"
    HEURED = "R1C6"
    NOFICHE = "R1C3"
    NOMD = "R3C3"
    CVREC = "R4C9"
    DATELIM = "R5C11"
    HEURELIM = "R5C12"
    CVDLIM = "R5C13"
    TJMO = "R1C14"
    TJMN = "R2C14"
    ACCUS = "R4C5"
    CV1 = "R7C1"
    CV1H = "R7C2"
    TYPEB = "R4C3"
    NBCVR = "R1C9"
    NBCVOK = "R2C9"
    NBCV48 = "R3C9"
    SLA = "R4C9"
    CVRET = "R1C12"
    ENT = "R3C12"
    RETOUR = "R4C12"
 
'   Détermination du nom du fichier à ouvrir
    fic = fic1 & Range(CStr("G2")) & "" & fic2 & Range(CStr("G2"))
    If Cells(2, 7).Value < 99 Then
      fic = fic1 & fic3 & Range(CStr("G2")) & "" & fic2 & fic3 & Range(CStr("G2"))
    End If
 
    If Cells(2, 7).Value < 10 Then
      fic = fic1 & fic33 & Range(CStr("G2")) & "" & fic2 & fic33 & Range(CStr("G2"))
    End If
 
' Test fichier ouvert
 
    If ClasseurEstOuvert(fic) Then
        MsgBox "Le fichier " & fic & " est ouvert." & vbLf & vbLf & "Arrêt de la procédure" & vbLf & vbLf & "Fermer le fichier et relancer"
    Else
 
        '   Ouverture du fichier
        Workbooks.Open Filename:=fic
   
        Windows("Suivi des besoins.xls").Activate
   
        '   Activation de la cellule pour mise à jour "Date de la demande"
        Range("B" + CStr(Range("G1"))).Select
        '   Constitution de la formule "='[Suivi Fiche 018.xls]Besoin'!R1C6" avec le 018 en paramètre
        formule = fic4 & Range(CStr("G2")) & fic5 & DATED
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & DATED
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & DATED
        End If
        ActiveCell.FormulaR1C1 = formule
   
        '   Activation de la cellule pour mise à jour "Heure de la demande"
        Range("C" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & HEURED
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & HEURED
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & HEURED
        End If
        ActiveCell.FormulaR1C1 = formule

        '   Activation de la cellule pour mise à jour "N° de Fiche"
        Range("E" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & NOFICHE
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & NOFICHE
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & NOFICHE
        End If
        ActiveCell.FormulaR1C1 = formule

        '   Activation de la cellule pour mise à jour "Nom du demandeur"
        Range("I" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & NOMD
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & NOMD
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & NOMD
        End If
        ActiveCell.FormulaR1C1 = formule
 
        '   Activation de la cellule pour mise à jour "CV Reçus sous 2 Jours"
        Range("J" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & CVREC
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & CVREC
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & CVREC
        End If
        ActiveCell.FormulaR1C1 = formule
 
        '   Activation de la cellule pour mise à jour "Date limite de traitement par Adjust"
        Range("K" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & DATELIM
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & DATELIM
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & DATELIM
        End If
        ActiveCell.FormulaR1C1 = formule

        '   Activation de la cellule pour mise à jour "Heure limite de traitement par Adjust"
        Range("L" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & HEURELIM
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & HEURELIM
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & HEURELIM
        End If
        ActiveCell.FormulaR1C1 = formule
   
        '   Activation de la cellule pour mise à jour "NB CV OK 48"
        Range("N" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & NBCV48
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & NBCV48
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & NBCV48
        End If
        ActiveCell.FormulaR1C1 = formule

        '   Activation de la cellule pour mise à jour "Accusé réception"
        Range("O" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & ACCUS
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & ACCUS
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & ACCUS
        End If
        ActiveCell.FormulaR1C1 = formule
   
        '   Activation de la cellule pour mise à jour "NB CV Reçus sous date limite de traitement"
        Range("P" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & CVDLIM
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & CVDLIM
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & CVDLIM
        End If
        ActiveCell.FormulaR1C1 = formule
   
        '   Activation de la cellule pour mise à jour "Heure Réception CV 1"
        Range("Q" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & CV1H
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & CV1H
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & CV1H
        End If
        ActiveCell.FormulaR1C1 = formule
   
        '   Activation de la cellule pour mise à jour "Type de besoin"
        Range("R" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & TYPEB
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & TYPEB
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & TYPEB
        End If
        ActiveCell.FormulaR1C1 = formule
   
        '   Activation de la cellule pour mise à jour "NB CV Reçu"
        Range("S" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & NBCVR
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & NBCVR
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & NBCVR
        End If
        ActiveCell.FormulaR1C1 = formule
   
        '   Activation de la cellule pour mise à jour "NB CV OK"
        Range("T" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & NBCVOK
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & NBCVOK
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & NBCVOK
        End If
        ActiveCell.FormulaR1C1 = formule
   
        '   Activation de la cellule pour mise à jour "NB CV RETENU"
        Range("U" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & CVRET
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & CVRET
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & CVRET
        End If
        ActiveCell.FormulaR1C1 = formule
   
        '   Activation de la cellule pour mise à jour "NB Entretien"
        Range("V" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & ENT
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & ENT
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & ENT
        End If
        ActiveCell.FormulaR1C1 = formule
   
        '   Activation de la cellule pour mise à jour "RETOUR"
        Range("W" + CStr(Range("G1"))).Select
        formule = fic4 & Range(CStr("G2")) & fic5 & RETOUR
        If Cells(2, 7).Value < 99 Then
           formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & RETOUR
        End If
        If Cells(2, 7).Value < 10 Then
           formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & RETOUR
        End If
        ActiveCell.FormulaR1C1 = formule

        ' Positionnement dans la cellule à gauche
        Range("A" + CStr(Range("G1"))).Select

        ' Fermeture du fichier
        fic = fic2 & Range(CStr("G2")) & fic6
        If Cells(2, 7).Value < 99 Then
           fic = fic2 & fic3 & Range(CStr("G2")) & fic6
        End If
        If Cells(2, 7).Value < 10 Then
           fic = fic2 & fic33 & Range(CStr("G2")) & fic6
        End If
        Workbooks(fic).Close
   
 End If
 
End Sub
Function ClasseurEstOuvert(strNomFichierComplet As String) As Boolean

  Set objExcel = New Excel.Application
 
  With objExcel
 
    ' L'instance d'Excel qui porte le fichier ne doit pas être visible
    .Visible = False
   
    .Workbooks.Open (strNomFichierComplet)
   
    ' Si le classeur est déjà ouvert cette propriété sera à True
    ClasseurEstOuvert = .Workbooks(1).ReadOnly
 
    .Quit
 
  End With
 
  ' Ne pas oublier de supprimer la référence à Excel
  ' sinon une autre instance fantôme hantera votre système...
  Set objExcel = Nothing
 
End Function
 
Bonjour Guy,
Merci pour tes explications, tu trouveras ci joint le code VBA, si des instructions te choquent, n'hésite pas, c'est à aujourd'hui mon premier code VBA sans avoir eu de formation...
Cdlt
Olivier
Hors Ligne
 Rapport   Haut 

Re: Comment tester si un fichier excel est déjà ouvert dans une macro
#10
Guy
Accro XLPages

Inscription: 09/01/2008
De Montréal, Québec

Messages: 463

Système d'exploitation:
PC
Version Excel utilisée:
97 à 2016
Posté le : 16-02-2011 11h23
Bonjour Olivier,

Je n'ai pas fait l'exégèse de ton code seulement j'ai supprimé les variables non déclarées et posé quelques constantes.

Pour la suite noter les remarques suivantes :
  • Dans l'éditeur VBA (VBE : Visual Basic Editor) sous le menu Outils/Options... onglet Éditeur, cocher Déclaration des variables obligatoire. Ce faisant tout nouveau module portera la directive Option Explicit. Microsoft, c'est connu, n'aide pas les codeurs en laissant cette option à vide par défaut
  • Pour tester la validité du code au fur et à mesure et repérer les erreurs de compilation utiliser abondamment le menu Débogage/Compiler VBAProject.
  • Dans la mesure du possible, lorsque le code est plutôt long, joindre un classeur portant ce code plutôt que de le transcrire dans le message.

Voilà pour l'heure, bonne continuation.

Cordialement,

Guy
Pièce jointe:
xls PourBasket.xls   [ Taille: 38.00 Ko - Téléchargements: 708 ]
Image redimensionnée

2pme
Hors Ligne
 Rapport   Haut 


Vous pouvez voir les sujets.
Vous ne pouvez pas débuter de nouveaux sujets.
Vous ne pouvez pas répondre aux contributions.
Vous ne pouvez pas éditer vos contributions.
Vous ne pouvez pas effacez vos contributions.
Vous ne pouvez pas ajouter de nouveaux sondages.
Vous ne pouvez pas voter en sondage.
Vous ne pouvez pas attacher des fichiers à vos contributions.
Vous ne pouvez pas poster sans approbation.

[Recherche avancée]


Qui consulte actuellement ce sujet ?   1 Utilisateur(s) anonymes