Test de l’état ouverts/fermés de 2 classeurs, si ils existent

Bonjour à tous & merci d’avance pour m’aider à résoudre ce problème, butant dessus depuis pas mal de temps

1 classeur de travail Automatismes.xlsm teste au lancement si 1-2 ou aucun des 2 classeurs suivants existe & son état

LIA maint.xlsm & LIA.xlsm sachant qu’ils sont placés respectivement dans 2 répertoires différents Crx-maint & Crx sur le bureau.

L’objectif est de mettre à 0 ou à 1 2 cellules (AF5-AF6) s’ils existent & 2 autres cellules (AG5-AG6) à 0 ou à 1 suivant leur état respectif.

Il ne peut il y avoir qu’un seul classeur ouvert à la fois sur les 2 & si l »un des classeurs ou les 2 n’existent pas, la ou les cellules d’état concernées reste(nt) vide(s).

Dans le code macro ci-dessous du classeur de travail, les seuls codes de test d’existence des 2 classeurs est bonne, mais

Aucun test des états n’est effectué pour aucun des 2 si il en existe au moins 1 des 2.

C’est EstClasseurouvert, des 2 fonctions ; qui demande un débogage

Merci d’avance de l’aide qui pourra m’être apportée.

Cordialement à tous

Public Sub Worksheet_Calculate()

‘Test si 2 classeurs existent ou pas

Dim Monclasseur1 As String, Monclasseur2 As String

Dim Verification As Boolean, Verification1 As Boolean, Verification2 As Boolean

Dim EstClasseurOuvert As String, EstClasseurOuvert1 As String, EstClasseurOuvert2 As String

If Range("AF5").Value <> "" And Range("AF6").Value <> "" And Range("AG5").Value <> "" And Range("AG6").Value <> "" Then Exit Sub

‘ chemin complet des 2 classeurs

Monclasseur1= Range("AK8").Value ‘ C:\Users\user\Desktop\Crx-maint\/LIA maint.xlsm

Monclasseur2= Range("AK9").Value ‘ C:\Users\user\Desktop\Crx\/LIA.xlsm

‘ Monclasseur1 existe ?

If Range("AF5").Value = "" And Dir(Monclasseur1, vbDirectory) <> vbNullString Then Range("AF5").Value = 1

If Range("AF5").Value = "" And Dir(Monclasseur1, vbDirectory) = vbNullString Then Range("AF5").Value = 0

‘ MonClasseur1 ouvert ?

' si Classeur1 existe, vérifier s'il est déjà ouvert

If Range("AF5").Value <> "" And Range("AF6").Value = "" Then Verification 1= EstClasseurOuvert(MonClasseur1)

If Verification1 = True Then

Range("AG5").Value =1

Else

Range("AG5").Value =0

End If

End If

‘ Monclasseur2 existe ?

If Range("AF6").Value = "" And Dir(Monclasseur2, vbDirectory) <> vbNullString Then Range("AF6").Value = 1

If Range("AF6").Value = "" And Dir(Monclasseur2, vbDirectory) = vbNullString Then Range("AF6").Value = 0

‘ MonClasseur2 ouvert ?

' si Classeur2 existe, vérifier s'il est déjà ouvert

If Range("AF5").Value <> "" And Range("AF6").Value <> "" Then Verification 2= EstClasseurOuvert(MonClasseur2)

If Verification2 = True Then

Range("AG6").Value =1

Else

Range("AG6").Value =0

End If

End If

‘ Si utilisation de EstClasseurOuvert1 & EstClasseurOuvert2 (Débogage Tableau attendu)

‘ Si utilisation de Verification1 & Vérification2 (Débogage Tableau attendu)

‘ Si utilisation de Verification (Débogage Tableau attendu)

‘ Fonction dans Module 2 Classeur1 ouvert-fermé

Function EstClasseurOuvert(MonClasseur1 As String)

Dim NumeroFichier1 As Long, NumeroErreur1 As Long

On Error Resume Next

NumeroFichier1 = FreeFile()

Open MonClasseur1 For Input Lock Read As #NumeroFichier1

Close NumeroFichier1

NumeroErreur1 = Err

On Error GoTo 0

Select Case NumeroErreur1

Case 0: EstClasseurOuvert = False

Case 70: EstClasseurOuvert = True

Case Else: Error NumeroErreur1

End Select

End Function

‘ Fonction dans Module 3 Classeur2 ouvert-fermé

Function EstClasseurOuvert(MonClasseur2 As String)

Dim NumeroFichier2 As Long, NumeroErreur2 As Long

On Error Resume Next

NumeroFichier2 = FreeFile()

Open MonClasseur2 For Input Lock Read As #NumeroFichier2

Close NumeroFichier2

NumeroErreur2 = Err

On Error GoTo 0

Select Case NumeroErreur2

Case 0: EstClasseurOuvert = False

Case 70: EstClasseurOuvert = True

Case Else: Error NumeroErreur2

End Select

End Function

Bonjour

code a tester

Public Sub Worksheet_Calculate()

    ' Test si 2 classeurs existent ou pas

    Dim Monclasseur1 As String, Monclasseur2 As String
    Dim Verification1 As Boolean, Verification2 As Boolean

    If Range("AF5").Value <> "" And Range("AF6").Value <> "" And Range("AG5").Value <> "" And Range("AG6").Value <> "" Then Exit Sub

    ' chemin complet des 2 classeurs
    Monclasseur1 = Range("AK8").Value ' C:\Users\user\Desktop\Crx-maint\LIA maint.xlsm
    Monclasseur2 = Range("AK9").Value ' C:\Users\user\Desktop\Crx\LIA.xlsm

    ' Monclasseur1 existe ?
    If Range("AF5").Value = "" Then
        If Dir(Monclasseur1) <> vbNullString Then
            Range("AF5").Value = 1
        Else
            Range("AF5").Value = 0
        End If
    End If

    ' MonClasseur1 ouvert ?
    If Range("AF5").Value <> "" And Range("AF6").Value = "" Then
        Verification1 = EstClasseurOuvert(Monclasseur1)
        If Verification1 = True Then
            Range("AG5").Value = 1
        Else
            Range("AG5").Value = 0
        End If
    End If

    ' Monclasseur2 existe ?
    If Range("AF6").Value = "" Then
        If Dir(Monclasseur2) <> vbNullString Then
            Range("AF6").Value = 1
        Else
            Range("AF6").Value = 0
        End If
    End If

    ' MonClasseur2 ouvert ?
    If Range("AF5").Value <> "" And Range("AF6").Value <> "" Then
        Verification2 = EstClasseurOuvert(Monclasseur2)
        If Verification2 = True Then
            Range("AG6").Value = 1
        Else
            Range("AG6").Value = 0
        End If
    End If

End Sub

' Fonction pour vérifier si un classeur est ouvert
Function EstClasseurOuvert(MonClasseur As String) As Boolean
    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

Bonjour le fil,

Pourquoi faire simple quand on peu faire compliqué ?
Matysek35, Vous avez la collection 'Workbooks qui est disponible et qui vous donne tous les classeurs qui sont ouverts.

Un simple boucle vous indiquera si un classeur est ouvert ou non.

Public Function WorkbookIsOpen(ByVal path As String) As Boolean
    Dim wb As Workbook
    If path > vbNullString Then
        Dim fullPath As String
        fullPath = LCase$(path)

        For Each wb In Application.Workbooks
            If LCase$(wb.FullName) = fullPath Then
                WorkbookIsOpen = True
                Exit Function
            End If
        Next wb
    Else
        WorkbookIsOpen = False
    End If
End Function

Et pour savoir si le classeur est présent sur le disque:

Public Function WorkbookExists(ByVal value As String) As Boolean
    If value > vbulstring Then
        WorkbookExists = Dir$(value, vbNormal) > vbNullString
    Else
        WorkbookExists = False
    End If
End Function

Joco7915, vous êtes sûr de cette ligne ?

    If Range("AF5").Value <> "" And Range("AF6").Value <> "" And Range("AG5").Value <> "" And Range("AG6").Value <> "" Then Exit Sub

Maintenant est-il judicieux de faire le test quand la feuille se calcule ?

Pour mettre à jour la cellule "AF5"

Option Explicit

Private Sub Workbook_Open()
    '// Teste si les classeurs sont présents sur le disque, et mets à jour les cellules
    With Feuil1 '// mettez le véritable nom de la feuille (son Code Name)
        .Range("AF5").value = WorkbookExists(.Range("AK8").value)
        .Range("AF6").value = WorkbookExists(.Range("AK9").value)
    End With

    '// Test si less classeurs sont ouverts et met à jour les cellules
    With Feuil1
        .Range("AG5").value = WorkbookIsOpen(.Range("AK8").value)
        .Range("AF6").value = WorkbookIsOpen(.Range("AK9").value)
    End With
End Sub