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

Erakmur

XLDnaute Occasionnel
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
 

Pièces jointes

  • Nouveau Feuille de calcul Microsoft Excel.xlsx
    19.5 KB · Affichages: 7

fanch55

XLDnaute Barbatruc
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 :
VB:
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
1713277219267.png

VB:
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
 

Pièces jointes

  • Nouveau Feuille de calcul Microsoft Excel.xlsm
    33 KB · Affichages: 5
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Erakmur, Fanch, Nain porte quoi,
Franchement à labour, mais comme c'est fait, un essai en PJ avec :
Dans Thisworkbook :
VB:
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 :
Code:
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
 

Pièces jointes

  • Nouveau Feuille de calcul Microsoft Excel (1).xlsm
    30.3 KB · Affichages: 6

Erakmur

XLDnaute Occasionnel
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 ?
 

fanch55

XLDnaute Barbatruc
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 .
 

fanch55

XLDnaute Barbatruc
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
VB:
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
 

Pièces jointes

  • Erakmur_Fanch55.xlsm
    34 KB · Affichages: 2

Valtrase

XLDnaute Occasionnel
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)

000502.png

Ensuite coller le code ci-dessous dans ThisWorkBook
VB:
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 :
Code:
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
VB:
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
 

Pièces jointes

  • Nouveau Feuille de calcul Microsoft Excel.xlsm
    73.9 KB · Affichages: 3
Dernière édition:

Erakmur

XLDnaute Occasionnel
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 ?
 

Pièces jointes

  • Nouvelle matrice de démarrage V7 - Copie - Copie.xlsm
    718.9 KB · Affichages: 11

Erakmur

XLDnaute Occasionnel
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
VB:
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
 

Discussions similaires

Réponses
36
Affichages
2 K
Réponses
16
Affichages
1 K

Statistiques des forums

Discussions
313 274
Messages
2 096 754
Membres
106 739
dernier inscrit
jcdu16