Microsoft 365 Afficher onglets quand toutes les questions sont répondues

Private Sub Workbook_Open()
  ' Appel de la Sub Is_Tout_Oui de la feuille InfoSite
   If Not Worksheets("1. Info Site").Is_Tout_Oui _
   Then MsgBox "Merci de répondre aux 15 questions" & vbLf _
             & "sur les contrôles règlementaires onglet 1. Info Site" & vbLf _
             & "en mettant X dans OUI ou NON", vbInformation
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
    For Each Cel In Target
        If Not Intersect(Cel, [Control_List]) Is Nothing Then
            Application.EnableEvents = False
            If Cel = "" Then
               Cel.Offset(, IIf(Cel.Column = [Control_List].Columns(1).Column, 1, -1)) = "X"
            Else
               If Cel <> "X" Then Cel = "X"
               Cel.Offset(, IIf(Cel.Column = [Control_List].Columns(1).Column, 1, -1)).ClearContents
            End If
            Is_Tout_Oui
            Application.EnableEvents = True
        End If
    Next
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count = 1 Then
        ' On a cliqué sur une des cellules sous OUI ou NON
        If Not Intersect(Target, [Control_List]) Is Nothing Then Target = "X"
    End If
End Sub

Function Is_Tout_Oui() As Boolean
Dim Sht As Worksheet
Application.ScreenUpdating = False
    Is_Tout_Oui = WorksheetFunction.CountBlank(Me.[Control_List].Columns(1)) = 0
    For Each Sht In ThisWorkbook.Worksheets
        Select Case Sht.Name
            Case "Tutoriel":        Sht.Visible = True
            Case "1. Info Site":    Sht.Visible = True
                [Control_List].Cells(1).Offset(-1).Select
            Case Else: Sht.Visible = Is_Tout_Oui
        End Select
    Next
End Function

Private Sub Workbook_Open()
If Application.CountIf([E9:F23], "X") = 15 Then Exit Sub
For Each F In Worksheets
    If F.Name <> "Tutoriel" And F.Name <> "1. Info Site" Then Sheets(F.Name).Visible = 2
Next F
Sheets("1. Info Site").Select
MsgBox "Veuillez répondre aux 15 questions du questionnaire."
End Sub

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [E9:F23]) Is Nothing Then
        If Application.CountIf([E9:F23], "X") = 15 Then
            Application.ScreenUpdating = False
            Feuilles = Array("2. Relevé Equipem. Prise en ch.", "3. Création du planning", "Gamme standard", _
                "Gamme UGAP.", "Gammes spécifiques.", "Compteur", "Synthèse Amdec 1", "Synthèse Amdec 2", _
                "Synthèse Amdec 3", "Synthèse Amdec 4", "Synthèse Amdec 5")
            For i = 0 To UBound(Feuilles)
                Sheets(Feuilles(i)).Visible = -1
            Next i
        End If
    End If
Fin:
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  ' On a cliqué sur une des cellules sous OUI ou NON
    If Not Intersect(Target, [Control_List]) Is Nothing Then Target = "X"
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range, Decalage As Integer
    For Each Cel In Target
        If Not Intersect(Cel, [Control_List]) Is Nothing Then
            Application.EnableEvents = False
            Decalage = IIf(Cel.Column = [Control_List].Columns(1).Column, 1, -1)
            If Cel = "" Then
               Cel.Offset(, Decalage) = "X"
            Else
               If Cel <> "X" Then Cel = "X"
               Cel.Offset(, Decalage).ClearContents
            End If
            Is_Tout_Oui
            Application.EnableEvents = True
        End If
    Next
End Sub
Function Is_Tout_Oui() As Boolean
Dim Sht As Worksheet
Application.ScreenUpdating = False
    Is_Tout_Oui = WorksheetFunction.CountBlank(Me.[Control_List].Columns(1)) = 0
    For Each Sht In ThisWorkbook.Worksheets
        Select Case Sht.Name
            Case "Tutoriel":        Sht.Visible = True
            Case "1. Info Site":    Sht.Visible = True
            Case Else:              Sht.Visible = Is_Tout_Oui
        End Select
    Next
End Function

Option Explicit

Private Sub Workbook_Open()
    InitWorkbook
End Sub

Private Sub InitWorkbook()
    MsgBox """Merci de répondre aux 15 questions sur les contrôles règlementaires onglet 1.", vbOKOnly, Application.Name
    Current.DisplayWorksheets Current.GetIsReady
End Sub

Option Explicit

Public Sub DisplayWorksheets(ByVal Display As Boolean)
    On Error GoTo Catch
    Application.ScreenUpdating = False

    Dim itemSheet As Excel.Worksheet

    For Each itemSheet In ThisWorkbook.Worksheets
        With itemSheet
            If .CodeName Like "sh_*" Then .Visible = xlSheetVisible
        End With
    Next itemSheet

    For Each itemSheet In ThisWorkbook.Worksheets
        With itemSheet
            If .CodeName Like "sys_*" Then .Visible = IIf(Display = True, xlSheetVisible, xlSheetVeryHidden)
        End With
    Next itemSheet

Catch:
    Application.ScreenUpdating = True
End Sub

Public Function GetIsReady() As Boolean
    Dim item As Excel.Shape
    Dim IsReady As Boolean
    IsReady = True
    For Each item In sh_InfoSite.Shapes
        If item.Type = msoOLEControlObject Then
            Dim itemOLE As msforms.CheckBox
            Set itemOLE = item.OLEFormat.Object.Object
            If Not itemOLE Is Nothing Then
                If itemOLE.Value = False Then
                    IsReady = False
                    Exit For
                End If
            End If
        End If
    Next
    GetIsReady = IsReady
End Function

Option Explicit

Private Sub BAES_Click()
    Current.DisplayWorksheets Current.GetIsReady
End Sub

Private Sub ConduitsDeFumees_Click()
    Current.DisplayWorksheets Current.GetIsReady
End Sub

Private Sub DetectionIncendie_Click()
    Current.DisplayWorksheets Current.GetIsReady
End Sub

Private Sub Diconnecteur_Click()
    Current.DisplayWorksheets Current.GetIsReady
End Sub

Private Sub Eau_Click()
    Current.DisplayWorksheets Current.GetIsReady
End Sub

Private Sub Electrique_Click()
    Current.DisplayWorksheets Current.GetIsReady
End Sub

Private Sub Extincteur_Click()
    Current.DisplayWorksheets Current.GetIsReady
End Sub

Private Sub FluideFrigorigene_Click()
    Current.DisplayWorksheets Current.GetIsReady
End Sub

Private Sub Levage_Click()
    Current.DisplayWorksheets Current.GetIsReady
End Sub

Private Sub MoyenDeSecours_Click()
    Current.DisplayWorksheets Current.GetIsReady
End Sub

Private Sub PorteEtPortail_Click()
    Current.DisplayWorksheets Current.GetIsReady
End Sub

Private Sub ProtectionEquipement_Click()
    Current.DisplayWorksheets Current.GetIsReady
End Sub

Private Sub ProtectionIncendie_Click()
    Current.DisplayWorksheets Current.GetIsReady
End Sub

Private Sub Sanitaire_Click()
    Current.DisplayWorksheets Current.GetIsReady
End Sub

Private Sub Sprinkler_Click()
    Current.DisplayWorksheets Current.GetIsReady
End Sub

If Application.CountIf([E23:F37], "X") >= 15 Then