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

[Erakmur]

Bonjour,
Dans le fichier joint, onglet 1. Info Site, vous avez une liste de 15 questions avec OUI ou NON comme réponse.
A l'ouverture du fichier, un pop up doit s'ouvrir avec comme message "Merci de répondre aux 15 questions sur les contrôles règlementaires onglet 1. Info Site en mettant X dans OUI ou NON".
Tant que toutes les réponses n'ont pas été données, tous les onglets sauf Tutoriel est 1. Info Site. restent masqués.
Une fois que les réponses ont été toutes données, les onglets suivant s'affichent:
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
Les autres onglets présents restent masqués comme toto, titi, tata par exemple.

Quelqu'un peut il m'aider ?
Cordialement

 

[fanch55]

Edit: codes corrigés car oubli du message à produire ....
Bonjour,
Le classeur avec macros ci-joint devrait répondre à votre demande .
Dans le module "ThisWorkboook", le code ci-dessous s'exécute à l'ouverture du Classeur :

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

Dans le module de la feuille Info Site :
( on a défini un nom pour les cellules devant avoir OUI ou NON

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

 

[Nain porte quoi]

Hello,

parce que j'avais un peu de temps

 

[sylvanu]

Bonjour Erakmur, Fanch, Nain porte quoi,
Franchement à labour, mais comme c'est fait, un essai en PJ avec :
Dans Thisworkbook :

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

Dans 1. Info Site :

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

 

[Erakmur]

Bonjour Messieurs,
Merci d'avoir répondu à mes attentes, cela fonctionne parfaitement.
Il y a néanmoins un petit détail à modifier. La msgbox ne doit s'ouvrir uniquement si les réponses ne sont pas données. En effet, un fois le questionnaire répondu, j'enregistre le fichier, je le ferme mais quand je le réouvre, le message apparait à nouveau alors que les réponses ont été données. Pouvez vous modifier ce détail ?

 

[sylvanu]

Re,
Un nouvel essai.

 

[fanch55]

Bonjour Messieurs,
Merci d'avoir répondu à mes attentes, cela fonctionne parfaitement.
Il y a néanmoins un petit détail à modifier. La msgbox ne doit s'ouvrir uniquement si les réponses ne sont pas données. En effet, un fois le questionnaire répondu, j'enregistre le fichier, je le ferme mais quand je le réouvre, le message apparait à nouveau alors que les réponses ont été données. Pouvez vous modifier ce détail ?

Normalement, le classeur au #2 vérifie l'état à l'ouverture et ne donc plus produire de message .

 

[Erakmur]

Normalement, le classeur au #2 vérifie l'état à l'ouverture et ne donc plus produire de message .

Malheureusement, ton fichier ne fonctionne pas. Je n'arrive pas à supprimer les X dans les cellules. Excel les recréés automatiquement

 

[Erakmur]

Re,
Un nouvel essai.

Les onglets toto, titi et tata on disparu ? Je n'arrive pas à les afficher

 

[sylvanu]

Les onglets toto, titi et tata on disparu ?

Oups. Corrigé en PJ.

 

[fanch55]

Malheureusement, ton fichier ne fonctionne pas. Je n'arrive pas à supprimer les X dans les cellules. Excel les recréés automatiquement

Il y a 2 colonnes qui selon moi devraient être toujours renseignées, à savoir OUI ou NON.
Il est vrai que l'événement SelectionChange est un peu trop "inflexible" tel que codée ( je n'avais pensé qu'au clic souris ).
Aussi , j'ai remplacé l'événement SelChange par un BeforeDoubleClick qui permet de basculer de OUI à NON sur un doubleclic de souris

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

 

[Valtrase]

Bonjour à tous,
Je propose une autre approche :
Mettre autant de contrôles activeX sur la feuille que nécessaire.
Renommer les feuilles avec un CodeName commençant soit par "sh_" pour les feuilles restant toujours visibles soit par "sys_" pour les feuilles qui doivent être cachées. (cf.Photo ci-dessous)

Ensuite coller le code ci-dessous dans ThisWorkBook

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

Et dans un module nommé Current coller le code Ci-dessous :

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

Edit: Modifications pour mise à jour aprés ouverture du classeur
code de la feuille Infosite

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

 

[Erakmur]

Oups. Corrigé en PJ.

Bonjour, Quand je copie colle ta macro sur le fichier final, je change juste la plage en E23:F37 mais cela n'affiche pas les onglets quand la dernière question est répondue. J'enregistre et quand j'ouvre, les onglets apparaissent. Il faut donc enregistrer le fichier et le fermer puis le réouvrir pour que cela fonctionne alors que dans ton fichier, tout marche nickel. Tu sais pourquoi ?

 

[Erakmur]

Il y a 2 colonnes qui selon moi devraient être toujours renseignées, à savoir OUI ou NON.
Il est vrai que l'événement SelectionChange est un peu trop "inflexible" tel que codée ( je n'avais pensé qu'au clic souris ).
Aussi , j'ai remplacé l'événement SelChange par un BeforeDoubleClick qui permet de basculer de OUI à NON sur un doubleclic de souris

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

Bonjour,
Toujours le même problème. A l'ouverture du fichier tout doit être vierge. La personne doit décider après de mettre un X dans OUI ou NON. Il ne doit pas avoir de cellule remplie. Quand je supprime les X, excel les recréer automatiquement

 

[sylvanu]

Bonsoir,
Je pense que l'erreur vient du fait qu'il y avait deux lignes à modifier :

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

C'est là qu'on compte les "x".