Ouvrir classeur et test si déjà ouvert

Bonjour à tous,

J'ouvre un classeur, depuis un autre classeur, ainsi :

...
Call ouvre(resultat1)
...
...
Sub Ouvre(wbMyWb As Workbook)
 Dim Nom_Fichier As Variant
 Nom_Fichier = Application.GetOpenFilename("Fichiers Excel , *.xls; *.xlsx")
 If Nom_Fichier <> False Then Set wbMyWb = Workbooks.Open(Nom_Fichier)
End Sub

Si le fichier n'est pas ouvert, tout se déroule normalement.

Si le fichier est déjà ouvert, le système affiche un message disant que le fichier est déjà ouvert et demande si l'on souhaite le réouvrir ou pas.

Si l'on clique oui, alors il réouvre et mon code continu, si l'on clique sur non il y a une erreur 400.

Je souhaiterais ne pas afficher le message disant que le fichier est déjà ouvert et simplement continuer mon code dans ce cas-là, sans réouvrir le fichier en question donc.

J'ai cherché sur le Web et ne trouve pas réellement réponse. Si quelqu'un peut m'aider...merci d'avance.

Bonjour

Essaye ça

Sub Ouvre(wbMyWb As Workbook)
 Dim Nom_Fichier As Variant
 Nom_Fichier = Application.GetOpenFilename("Fichiers Excel , *.xls; *.xlsx")
Application.DisplayAlerts = False
 If Nom_Fichier <> False Then Set wbMyWb = Workbooks.Open(Nom_Fichier)
Application.DisplayAlerts = true
End Sub

Merci GGAUTIER. Cela semble fonctionner.

Le truc c'est qu'en fesant ça je pense que le classeur se ré-ouvre. Si jamais tu as ouvert le classeur, que tu y à apporter des modifications le fichier va être ré-ouvert et tout ce que tu as fait sera perdu, il faut que tu testes cette éventualité !

Voilà le code qui va bien, je ne l'ai pas inventé

Function EstClasseurOuvert(MonClasseur As String)
'par: https://excel-malin.com

Dim NumeroFichier As Long, NumeroErreur As Long

    On Error Resume Next
    NumeroFichier = FreeFile()
    Open MonClasseur For Input Lock Read As #NumeroFichier
    Close NumeroFichier
    NumeroErreur = Err
    On Error GoTo 0

    Select Case NumeroErreur
    Case 0:    EstClasseurOuvert = False
    Case 70:   EstClasseurOuvert = True
    Case Else: Error NumeroErreur
    End Select
End Function

Sub ExempleTestOuvertureClasseur()
'par: https://excel-malin.com
    Dim Verification As Boolean
    Dim MonClasseur As String

    MonClasseur = "Adresse du fichier"

    'd'abord le test si le fichier existe
    If Len(Dir(MonClasseur)) = 0 Then 's'il n'existe pas, montrer un avertissement et quitter la macro
        MsgBox "Le classeur n'existe pas ou à été déplacé, impossible de poursuivre.", vbCritical, "Erreur"
        Exit Sub
    Else
    End If

    'si le Classeur existe, vérifier s'il est déjà ouvert
    Verification = EstClasseurOuvert(MonClasseur)

    If Verification = True Then
        'Classeur ouvert
    Else
        Workbooks.Open (MonClasseur)
    End If
End Sub

Oui en fait il se réouvre tout seul et en silence.

Je vais tester ton code.

Merci.

Alors voici ce que j'ai fait

...
Call Ouvre(resultat1)
...

Sub Ouvre(wbMyWb As Workbook)
 Dim Nom_Fichier As Variant
 Dim verification As Boolean
 Nom_Fichier = Application.GetOpenFilename("Fichiers Excel , *.xls; *.xlsx")
 Application.DisplayAlerts = False
 If Nom_Fichier <> False Then
  verification = EstClasseurOuvert(Nom_Fichier)
  If verification = True Then
   'Classeur ouvert
  Else
  Set wbMyWb = Workbooks.Open(Nom_Fichier)
  End If
 Application.DisplayAlerts = True
End Sub
...
Function EstClasseurOuvert(MonClasseur As String)
'par: https://excel-malin.com
Dim NumeroFichier As Long, NumeroErreur As Long

    On Error Resume Next
    NumeroFichier = FreeFile()
    Open MonClasseur For Input Lock Read As #NumeroFichier
    Close NumeroFichier
    NumeroErreur = Err
    On Error GoTo 0

    Select Case NumeroErreur
    Case 0:    EstClasseurOuvert = False
    Case 70:   EstClasseurOuvert = True
    Case Else: Error NumeroErreur
    End Select
End Function
...

Là j'ai l'erreur Type d'argument ByRef incompatible. Il butte sur "verification = EstClasseurOuvert(Nom_Fichier)"

Est-ce à cause de (MonClasseur As String) ?

Oui j'ai enlevé "As String" et il n' a plus l'erreur.

Par contre si le fichier est déjà ouvert, cela ne renvoie rien et donc rien ne se passe. Je cherche...

Voila mon If verification et cela fonctionne...

  If verification = True Then
   'Classeur ouvert
   Set wbMyWb = Workbooks.Item(2)
  Else
   Set wbMyWb = Workbooks.Open(Nom_Fichier)
  End If

Merci encore à toi.

De rien pour le coup ta réussi à corriger tout seul et l'adapter a ton besoins ! Bonne continuation

Merci.

J'ai même rajouté un plus qui me permet d'avoir le bon index en dynamique au lieu de figé :

...
If verification = True Then
   'Classeur ouvert
   ind = chercher_index(Nom_Fichier)
   If ind <> 0 Then
    Set wbMyWb = Workbooks.Item(ind)
   End If
  Else
   Set wbMyWb = Workbooks.Open(Nom_Fichier)
  End If
  ...
  ...
  Function chercher_index(Nom_Classeur)
 Dim i As Integer
 chercher_index = 0
 For i = 1 To Workbooks.Count
  If Workbooks(i).FullName = Nom_Classeur Then
   chercher_index = i
   Exit For
  End If
 Next i
End Function
...
Rechercher des sujets similaires à "ouvrir classeur test deja ouvert"