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

E

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
Trier par date Trier par votes
fanch55

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:
Vote positif 0 Vote négatif
sylvanu

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
Vote positif 0 Vote négatif
E

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 ?
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
Erakmur à dit:
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 ?
Cliquez pour agrandir...
Normalement, le classeur au #2 vérifie l'état à l'ouverture et ne donc plus produire de message .
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
Erakmur à dit:
Malheureusement, ton fichier ne fonctionne pas. Je n'arrive pas à supprimer les X dans les cellules. Excel les recréés automatiquement
Cliquez pour agrandir...
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
Vote positif 0 Vote négatif
Valtrase

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:
Vote positif 0 Vote négatif
E

Erakmur

XLDnaute Occasionnel
sylvanu à dit:
Oups. Corrigé en PJ.
Cliquez pour agrandir...
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
Vote positif 0 Vote négatif
E

Erakmur

XLDnaute Occasionnel
fanch55 à dit:
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
XL 2021 Protection des onglets
Réponses
2
Affichages
187
MANU64360
M
B
  • Question
XL 2016 Macro BVA pour créer une synthèse à partir de plusieurs onglets Excel
Réponses
6
Affichages
853
bnolwalid
B
S
  • Question
XL 2019 Regrouper sur un seul onglet toutes les informations de plusieurs onglets
Réponses
3
Affichages
2 K
chris
chris
T
  • Question
Microsoft 365 Ouverture de fichier
2 3
Réponses
36
Affichages
2 K
TooFatBoy
TooFatBoy
L
  • Résolu(e)
XL 2016 Problème liaison USF vers tableau et inversément
Réponses
1
Affichages
460
Ludo G
L
A
  • Question
Microsoft 365 Copie VBA d'un tableau présent et identique sur 12 onglets dans un autre onglet dont seules les lignes complétées sont copiées
Réponses
4
Affichages
635
AlexiaC
A
M
  • Question
Microsoft 365 formules / macros
2
Réponses
16
Affichages
2 K
fanfan38
fanfan38
T
  • Résolu(e)
Microsoft 365 Conditionner l'accès à une page d'un multipage
2
Réponses
26
Affichages
2 K
TooFatBoy
TooFatBoy
Simbaa
  • Question
Microsoft 365 Création d'un fichier entier par rapport à des entrées via UserForm
Réponses
1
Affichages
557
job75
job75
Roseline
  • Résolu(e)
XL 2013 Afficher les colonnes de plusieurs onglets en même temps par vba
Réponses
4
Affichages
2 K
Roseline
Roseline

Membres actuellement en ligne

14 membres et 71 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 088
Messages
2 116 089
Membres
112 658
dernier inscrit
doro 76