Détecter qu'un classeur est déjè ouvert

[siocnarf]

Bonjour,

Dans le code ici-bas, j'ouvre une boite de dialogue pour sélectionner puis ouvrir un autre classeur excel. Je me demande s'il y a une manière qui me permettrait de ne pas ouvrir le classeur sélectionné si celui-ci est déjà ouvert?

Dim sfiltre As String
Dim STitre As String
Dim SNomDossier As String
Dim IntFilterIndex As Integer
Dim Filename As Variant
Dim StrNomduFichier As String


'http://www.tek-tips.com/faqs.cfm?fid=4114
'sfiltre = "Fichiers Excel (*.xls),*.xls;*.xlsx" 'Filtre à appliquer
sfiltre = "Fichiers office, *.xls;*.xlsx" 'Filtre à appliquer
'sfiltre = "Fichiers Excel (*.xls),*.xls" 'Filtre à appliquer
IntFilterIndex = 1

STitre = "Choisissez un fichier contenant les données à recompiler" 'Titre de la boite
SNomDossier = Application.ActiveWorkbook.Path 'Chemin initial
SNomDossier = SNomDossier & "\Data"
StrDrive = Mid(SNomDossier, 1, 1)

'On applique l'emplacement des fichiers.
ChDrive (StrDrive)
ChDir (SNomDossier)
With Application
    ' Set File Name to selected File
    Filename = .GetOpenFilename(sfiltre, IntFilterIndex, STitre)
    ' Reset Start Drive/Path
    ChDrive (Left(.DefaultFilePath, 1))
    ChDir (.DefaultFilePath)
End With

'On trouve le nom du fichier
StrNomduFichier = Mid(Filename, InStrRev(Filename, "\") + 1, Len(Filename))

If Filename = False Then
    MsgBox "Pas de fichier sélectionné"
    Exit Sub
End If

Call ouvrefichier(Filename)
' Open File
'Workbooks.Open Filename

'Permet de lancer une recompilation
Call GenerationdeBase(1, StrNomduFichier)

End Sub
'============================================
'============================================
Sub ouvrefichier(o_Filename)
On Error Resume Next
Workbooks.Open o_Filename
If Err.Number <> 0 Then

    MsgBox "Il y a un problème à ouvrir ce fichier"
    End
    
End If
MsgBox o_Filename, vbInformation, "Fichier ouvert avec succès!" ' This can be removed
End Sub

Merci,

 

[JCGL]

Re : Détecter qu'un classeur est déjè ouvert

Bonjour à tous,

Peux-tu essayer en rajoutant un On Error Resume Next :

'============================================
'============================================
Sub ouvrefichier(o_Filename)
    On Error Resume Next
    Workbooks.Open o_Filename
    If Err.Number <> 0 Then
        MsgBox "Il y a un problème à ouvrir ce fichier"
        On Error Resume Next
        End
    End If
    MsgBox o_Filename, vbInformation, "Fichier ouvert avec succès!"    ' This can be removed
End Sub

A+ à tous

 

[Victor21]

Re : Détecter qu'un classeur est déjè ouvert

Bonjour, François

J'utilise ce code pour vérifier la présence et l'état (ouvert-fermé) de "Historique" dans le sous-répertoire "sauvegarde" du répertoire où je suis.

' Source    : SilkyRoad Sur Developpez.com
'---------------------------------------------------------------------------------------

Option Explicit

'Public i en début de module pour pouvoir récupérer la valeur hors de ce module
Public i As Integer

Private Function VerifClasseur(Fichier As String) As Integer

    Dim x As Integer

    On Error Resume Next
    x = FreeFile()

    Open Fichier For Input Lock Read As #x
    Close x

    VerifClasseur = Err.Number

    On Error GoTo 0

End Function

Function WOuvert(sNom As String) As Boolean

    ' Déclarer les variables
    Dim Wkb As Workbook

    ' Initialisation
    WOuvert = False

    ' Parcours des classeurs ouverts
    For Each Wkb In Workbooks
        If Wkb.Name = sNom Then
            WOuvert = True
            Exit For
        End If
    Next Wkb

End Function

Sub Etat()

    ' Déclarer les variables
    Dim oSh As String

    ' Initialiser les variables
    oSh = "Historique.xls"
    i = VerifClasseur(ThisWorkbook.Path & "\Sauvegardes\" & oSh)

    '---------------------------------------------------------------------------------------
    ' Provisoire, aux fins de tests
    '
    'Select Case i    ' Traiter selon l'état (ouvert-fermé-introuvable) de Histo
    '    Case 0:    ' "Historique" est fermé
    '        MsgBox "Histo est fermé. Etat :" & i
    '        MsgBox i
    '    Case 53:    ' "Histo" est introuvable
    '        If WOuvert(oSh) = False Then MsgBox "Histo est introuvable. Etat" & i
    '    Case 70:    ' "Histo" est ouvert
    '        MsgBox "Histo est ouvert.Etat :" & i
    '    Case Else:    ' Autres cas non gérés lors du test d'ouverture de "Histo"
    '        MsgBox "Erreur : " & i
    'End Select
    '---------------------------------------------------------------------------------------

End Sub

Reste à récupérer la variable i pour tes tests.

Edit Bonjour, JCGL

 

[siocnarf]

Re : Détecter qu'un classeur est déjè ouvert

Bonjour,

Avec votre suggestion, mon code ressemble à ceci. Cela semble bien fonctionner. À moins que vous voyiez un problème dans mon code.

Sub RecompilationdesEvenements()

Dim sfiltre As String
Dim STitre As String
Dim SNomDossier As String
Dim IntFilterIndex As Integer
Dim Filename As Variant
Dim StrNomduFichier As String
Dim StrDrive As String
Dim SData As String
Dim Wkb As Workbook
Dim Wouvert As String



sfiltre = ""
STitre = ""
SNomDossier = ""
IntFilterIndex = 0
Filename = ""
StrNomduFichier = ""
StrDrive = ""
SData = "\Data"
'http://www.tek-tips.com/faqs.cfm?fid=4114
'sfiltre = "Fichiers Excel (*.xls),*.xls;*.xlsx" 'Filtre à appliquer
sfiltre = "Fichiers office, *.xls;*.xlsx" 'Filtre à appliquer
'sfiltre = "Fichiers Excel (*.xls),*.xls" 'Filtre à appliquer
IntFilterIndex = 1

STitre = "Choisissez un fichier contenant les données à recompiler" 'Titre de la boite
SNomDossier = Application.ActiveWorkbook.Path 'Chemin initial
If Mid(SNomDossier, InStrRev(SNomDossier, "\"), Len(SNomDossier)) <> SData Then
    SNomDossier = SNomDossier & "\Data"
End If
StrDrive = Mid(SNomDossier, 1, 1)

'On applique l'emplacement des fichiers.
ChDrive (StrDrive)
ChDir (SNomDossier)
With Application
    ' Set File Name to selected File
    Filename = .GetOpenFilename(sfiltre, IntFilterIndex, STitre)
    ' Reset Start Drive/Path
    ChDrive (Left(.DefaultFilePath, 1))
    ChDir (.DefaultFilePath)
End With

'On trouve le nom du fichier
StrNomduFichier = Mid(Filename, InStrRev(Filename, "\") + 1, Len(Filename))

If Filename = False Then
    MsgBox "Pas de fichier sélectionné"
    Exit Sub
End If

' Initialisation
   Wouvert = False

' Parcours des classeurs ouverts
For Each Wkb In Workbooks
    If Wkb.Name = StrNomduFichier Then
       Wouvert = True
       Exit For
    End If
Next Wkb

If Wouvert = False Then

    Call ouvrefichier(Filename)
    ' Open File
    Workbooks.Open Filename
    
End If

'Permet de lancer une recompilation
Call GenerationdeBase(1, StrNomduFichier)

End Sub
'============================================
'============================================
Sub ouvrefichier(o_Filename)
On Error Resume Next
Workbooks.Open o_Filename
If Err.Number <> 0 Then

    MsgBox "Il y a un problème à ouvrir ce fichier"
    End
    
End If
MsgBox o_Filename, vbInformation, "Fichier ouvert avec succès!" ' This can be removed
End Sub

Merci,

François