XL 2021 Faire mieux mon code

[Usine à gaz]

Bonjour à toutes et à tous

Pour tester si un classeur est ouvert, j'ai un code :
Je dois tester 3 classeurs :

'SELECTION ICHIER RDdVs
    On Error Resume Next
    If Err <> 0 Then
        Windows("isitelImmobRdV ImenNF.xlsm").Activate
        MsgBox ("isitelImmobRdV ImenNF.xlsm OK!")
        Else
        MsgBox "isitelImmobRdV ImenNF.xlsm n'est pas ouvert"
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Exit Sub
    End If
   
    On Error Resume Next
    If Err <> 0 Then
        Windows("isitelImmobRdV SondaNF.xlsm").Activate
        MsgBox ("isitelImmobRdV SondaNF.xlsm OK!")
        Else
        MsgBox "isitelImmobRdV SondaNF.xlsm n'est pas ouvert"
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Exit Sub
    End If
   
    On Error Resume Next
    If Err <> 0 Then
        Windows("isitelImmobRdV StephanieNF.xlsm").Activate
        MsgBox ("isitelImmobRdV StephanieNF.xlsm OK!")
        Else
        MsgBox "isitelImmobRdV StephanieNF.xlsm n'est pas ouvert"
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Exit Sub
    End If

Objectif
Je voudrais tester sur le :
- 1er classeur : Si le classeur est ouvert, le test s'arrête : avec msgbox : Ouvert, et la suite de ma macro s'exécute...
- 2e. classeur : Si le classeur est ouvert, le test s'arrête : avec msgbox : Ouvert, et la suite de ma macro s'exécute...
- 3e. classeur : Si le classeur est ouvert, le test s'arrête : avec msgbox : Ouvert, et la suite de ma macro s'exécute...
- Si aucun classeur ouvert : Application.EnableEvents = True: Application.ScreenUpdating = True : Exit Sub

Je ne vois pas trop comment faire . Je cherche.....
Pourriez-vous m'aider ?
Grand merci à toutes et à tous,
Si nécessaire, je ferai un classeur test

 

[patricktoulon]

Bonjour lionel

Sub test2()
    mes_classeurs = "|isitelImmobRdV SondaNF.xlsm|isitelImmobRdVSondaNF.xlsm|isitelImmobRdV StephanieNF.xlsm|"
    Dim wbk As Workbook
    For Each wbk In Workbooks
        MsgBox wbk.Name
        If mes_classeurs Like "*|" & wbk.Name & "|*" Then
            Windows(wbk.Name).Activate
            Application.EnableEvents = True
            Application.ScreenUpdating = True
            Exit Sub
        Else
            MsgBox "LES CLASSEURS" & vbCrLf & Join(Split(mes_classeurs, "|"), vbCrLf) & vbCrLf & "SONT FERMÉS"
        End If
    Next
End Sub

 

[Eric KERGRESSE]

Bonjour,

Une autre proposition :

Dim Message As String
Dim I As Integer


    Message = ""
    
    For I = 1 To Workbooks.Count
        With Workbooks(I)
            Select Case .Name
                   Case "isitelImmobRdV ImenNF.xlsm"
                         .Activate
                         Message = "isitelImmobRdV ImenNF.xlsm OK!"
                         Exit For
                   Case "isitelImmobRdV SondaNF.xlsm"
                         .Activate
                         Message = "isitelImmobRdV SondaNF.xlsm OK!"
                         Exit For
                   Case "isitelImmobRdV StephanieNF.xlsm"
                         .Activate
                         Message = "isitelImmobRdV StephanieNF.xlsm OK!"
                         Exit For
            End Select
        End With
    Next I
    
    If Message = "" Then
       Application.EnableEvents = True
       Application.ScreenUpdating = True
       Exit Sub
    Else
       MsgBox Message
    End If

 

[dysorthographie]

Bonjour,

Sub test()
'SELECTION ICHIER RDdVs
    If Not (IsOpen("isitelImmobRdV ImenNF.xlsm") And _
    IsOpen("isitelImmobRdV SondaNF.xlsm") And _
    IsOpen("isitelImmobRdV StephanieNF.xlsm")) Then MsgBox "Aucun  n'est ouvert": Exit Sub
End Sub
Function IsOpen(Classeur As String) As Boolean
Dim Wb As String
On Error Resume Next
Wb = Windows(Classeur).Caption
IsOpen = Not CBool(Err)
Err.Clear
On Error GoTo 0
End Function

Edite

Sub test2()
'SELECTION ICHIER RDdVs
  If IsOpen("isitelImmobRdV ImenNF.xlsm") Then TraitementFichier (Windows("isitelImmobRdV ImenNF.xlsm")): Exit Sub
 If IsOpen("isitelImmobRdV SondaNF.xlsm") Then TraitementFichier Windows("isitelImmobRdV SondaNF.xlsm"): Exit Sub
 If IsOpen("isitelImmobRdV StephanieNF.xlsm") Then TraitementFichier Windows("isitelImmobRdV StephanieNF.xlsm"): Exit Sub
 
End Sub
Sub TraitementFichier(Fichier As Workbook)
 'Traitement
 
End Sub

 

[Usine à gaz]

Bjr patricktoulon
Bjr Eric KERGRESSE
Bjr dysorthographie

Je vous remercie pour vos retours
Je teste dès que j'ai un moment et je rendrai compte...
Encore MERCI

 

[job75]

Bonjour Lionel, le fil,

Il y a évidemment de nombreuses manières de traiter la question, en voici une autre :

Sub Test()
Dim a, wb As Workbook, flag As Boolean
a = Array("isitelImmobRdV ImenNF.xlsm", "isitelImmobRdV SondaNF.xlsm", "isitelImmobRdV StephanieNF.xlsm")
For Each wb In Workbooks
    If IsNumeric(Application.Match(wb.Name, a, 0)) Then MsgBox "'" & wb.Name & "' est ouvert": flag = True
Next
If Not flag Then MsgBox "Aucun des 3 fichiers n'est ouvert"
End Sub

A+

 

[Usine à gaz]

Bonjour et merci Gérard
Je n'ai pas eu le temps de répôndre à ce fil.
Je le ferai ce soir...

 

[Usine à gaz]

Bonjour et merci Gérard
Je n'ai pas eu le temps de répôndre à ce fil.
Je le ferai ce soir...

Bonsoir à tous
Je vous remercie encore pour vos codes qui fonctionnent nickel.

J'ai un beug sur celui de Eric KERGRESSE mais trop fatigué pour voir ce soir.
Grand Merci à tous pour m'avoir répondu.
Je vous souhaite une bonne nuit...

 

[Usine à gaz]

Bonsoir à tous
Je vous remercie encore pour vos codes qui fonctionnent nickel.

J'ai un beug sur celui de Eric KERGRESSE mais trop fatigué pour voir ce soir.
Grand Merci à tous pour m'avoir répondu.
Je vous souhaite une bonne nuit...

Voilàç le classeur test.
J'ai modifié les noms des classeurs pour faire plus simple

 

[Staple1600]

RE

@lionel
Franchement !
Comme dans son copié/collé, Eric n'a pas mis
Sub NomMacro()
...
End Sub
Tu n'as pas corrigé de toi-même !
Après tous ces messages sur le forum

 

[patricktoulon]

 

[TooFatBoy]

Bonjour,

'SELECTION ICHIER RDdVs
On Error Resume Next

If Err <> 0 Then
    Windows("isitelImmobRdV ImenNF.xlsm").Activate
    MsgBox ("isitelImmobRdV ImenNF.xlsm OK!")
Else
    MsgBox "isitelImmobRdV ImenNF.xlsm n'est pas ouvert"
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
End If

Euh... tu as remarqué que tu commences par tester s'il y a une erreur avant même d'avoir exécuté la moindre instruction ???


Et pourquoi mettre trois fois On Error Resume Next alors qu'il n'y a pas de On Error Goto xxx ?

 

[Usine à gaz]

Bonjour le fil, Bonjour le forum

Au réveil, j'ai repris le code de @Eric KERGRESSE.
Evidement il fonctionne avec le code complet.

Evidemment, les gardiens de la galaxie n'auront pas manqué la remarque...

 

[Eric KERGRESSE]

Bonjour à tous,

Merci Usine à gaz d'avoir vérifié, j'ai cru un instant devoir déposer le bilan...

 

[patricktoulon]

re
bonjour à tous
Ou lah !!! déposer le bilan ça pu ça ?

Ok je sorts