Toogle Button cacher/ désactiver colonne

Y compris Power BI, Power Query et toute autre question en lien avec Excel
P
Papi27190
Membre habitué
Membre habitué
Messages : 84
Inscrit le : 30 octobre 2017
Version d'Excel : 2013 EN

Message par Papi27190 » 19 septembre 2019, 10:40

Bonjour,

Je souhaite réaliser un fichier dans lequel je peux cacher certaines colonnes avec un bouton toogle, jusque la pas de souci je maîtrise :wink:
En plus de cela, j'aimerai "automatiser" la cellule active selon le principe suivant :

A l'ouverture du fichier la cellule active correspond à la première cellule vide de la première ligne vide.
Ensuite je voudrais que à chaque fois que la cellule active est remplie avec une valeur que le programme passe automatiquement à la cellule vide suivante sur la même ligne et ce jusqu' a la colonne 21.
Pour ensuite retourner automatiquement au début de la ligne suivante.

Le bouton doit donc tenir compte des colonnes ( E, H, K, M, P, S) cachées lors du déplacement de la cellule active : Si colonne caché alors ne pas mettre de valeur dans cette colonne. (passer à la suivante)

J'espère être compréhensible
Book1.xlsm
(21.96 Kio) Téléchargé 7 fois
.

Ci-joint un exemple.

Merci d'avance :)
g
gyrus
Membre fidèle
Membre fidèle
Messages : 311
Appréciations reçues : 43
Inscrit le : 8 avril 2019
Version d'Excel : 2013 FR

Message par gyrus » 19 septembre 2019, 14:10

Bonjour,

Une proposition ...

Cordialement.
Book1.xlsm
(23.69 Kio) Téléchargé 10 fois
P
Papi27190
Membre habitué
Membre habitué
Messages : 84
Inscrit le : 30 octobre 2017
Version d'Excel : 2013 EN

Message par Papi27190 » 19 septembre 2019, 16:40

Bonjour,

Merci de votre aide cela semble répondre au besoin ! :mrgreen:

J'essai l'ensemble du code dans mon fichier et vous dis si je rencontre un problème.
P
Papi27190
Membre habitué
Membre habitué
Messages : 84
Inscrit le : 30 octobre 2017
Version d'Excel : 2013 EN

Message par Papi27190 » 20 septembre 2019, 14:29

Bonjour,

J'ai procédé à l'intégration de votre code dans mon fichier mais j'ai un problème de variable que je ne parviens pas à résoudre... voir ligne avec ToogleButton...

Code :
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Dim I As Integer
Dim B As Integer


ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Application.EnableEvents = False
'
If Target = "" Then
    Call Positionnement
Else
    'If Target.Column = 20 Then Call ValidateList(Target.Row)
End If
'
Application.EnableEvents = True


'si colonne T
If Target.Column = 20 And Cells(ActiveCell.Row, 1).Value <> "" Then
    
    
    '...puis inscrit par défaut OK dans la cellule de la colonne T
    Cells(ActiveCell.Row, 20).Value = "OK"
    
    'boucle
    
[color=#FF0000] If ToggleButton1.Value = True Then [/color]
    
    
   For I = 4 To 19
   
    If Cells(ActiveCell.Row, I).Interior.ColorIndex = 3 And Cells(ActiveCell.Row, 3).Value <> Cells(ActiveCell.Row - 1, 3).Value Then
        
            Cells(ActiveCell.Row, 20).Value = "NOK"
                        
    If Cells(4, I).Interior.ColorIndex = 3 Then
        
            Cells(ActiveCell.Row, 20).Value = "NOK"
                
    End If
    End If
    
    If Cells(ActiveCell.Row, I).Interior.ColorIndex = 3 And Cells(ActiveCell.Row, 3).Value = Cells(ActiveCell.Row - 1, 3).Value Then Cells(ActiveCell.Row, 20).Value = "NOK"
    
    Next I
    
    Else

   For I = 4 To 19

        'si la couleur de la cellule en cours est différente de vert, NOK et fin !
        If Cells(ActiveCell.Row, I).Interior.ColorIndex <> 4 And Cells(ActiveCell.Row, 3).Value <> Cells(ActiveCell.Row - 1, 3).Value Then
        
            Cells(ActiveCell.Row, 20).Value = "NOK"
                        
            
        If Cells(4, I).Interior.ColorIndex <> 4 Then
        
            Cells(ActiveCell.Row, 20).Value = "NOK"
                
            End If
            End If

        If Cells(ActiveCell.Row, I).Interior.ColorIndex <> 4 And Cells(ActiveCell.Row, 3).Value = Cells(ActiveCell.Row - 1, 3).Value Then Cells(ActiveCell.Row, 20).Value = "NOK"
            

  Next I
     
  
    If Cells(ActiveCell.Row, 20).Value = "OK" Then
    Cells(ActiveCell.Row, 21).Value = "Validée"
    Call Positionnement
    End If
    
    If Cells(ActiveCell.Row, 20).Value = "NOK" And Cells(ActiveCell.Row, 3).Value <> Cells(ActiveCell.Row - 1, 3).Value Then
    MsgBox " Démonter le produit et refaire les mesures !", vbCritical + vbOKOnly, "Résultat des mesures"
    Call Positionnement
    End If
    
    If Cells(ActiveCell.Row, 20).Value = "NOK" And Cells(ActiveCell.Row, 3).Value = Cells(ActiveCell.Row - 1, 3).Value Then
    MsgBox "Mesure non valide, appeler le responsable qualité !", vbCritical + vbOKOnly, "Validation des mesures"
    Call Positionnement
    End If
    
End If
    
End Sub

Merci d'avance de votre aide ::D
g
gyrus
Membre fidèle
Membre fidèle
Messages : 311
Appréciations reçues : 43
Inscrit le : 8 avril 2019
Version d'Excel : 2013 FR

Message par gyrus » 20 septembre 2019, 16:28

Bonjour,

Il faut indiquer où se trouve le bouton bascule
If Sheet1.ToggleButton1.Value = True Then
De plus, je te conseille d'effectuer une analyse en pas à pas de ton programme.
L'évènement Workbook.SheetSelectionChange peut rapidement poser problème si l'activation/désactivation n'est pas correctement gérée.

Cordialement.
P
Papi27190
Membre habitué
Membre habitué
Messages : 84
Inscrit le : 30 octobre 2017
Version d'Excel : 2013 EN

Message par Papi27190 » 23 septembre 2019, 09:12

Bonjour,

Merci de votre réponse je test et vous fait un retour ! :mrgreen:

Cordialement
P
Papi27190
Membre habitué
Membre habitué
Messages : 84
Inscrit le : 30 octobre 2017
Version d'Excel : 2013 EN

Message par Papi27190 » 23 septembre 2019, 15:39

Re bonjour,

Merci de l'aide mais je suis confronté à une erreur que je ne comprend pas ... ci-joint le bout de code concerné au besoin je peux mettre le fichier complet.

Pour chaque ligne de code : Cells(ActiveCell.Row, 20).Value = "OK" J'ai l'erreur 1004....


code :
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Dim I As Integer
Dim B As Integer
Dim BtnBascule As ToggleButton

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Application.EnableEvents = False
'
If Target = "" Then
    Call Positionnement
Else
    'If Target.Column = 20 Then Call ValidateList(Target.Row)
End If
'
Application.EnableEvents = True

'si colonne T
If Target.Column = 20 And Cells(ActiveCell.Row, 1).Value <> "" Then

    '...puis inscrit par défaut OK dans la cellule de la colonne T
   ' Cells(ActiveCell.Row, 20).Value = "OK"           : Ligne ou apparaît l'erreur : run time error 1004 

    'boucle
If Feuil1.ToggleButton1.Value = True Then
'If BtnBascule.Value = True Then

   For I = 4 To 19
   
   If Cells(ActiveCell.Row, I).Interior.ColorIndex <> 3 And Cells(ActiveCell.Row, 3).Value <> Cells(ActiveCell.Row - 1, 3).Value Then

            Cells(ActiveCell.Row, 20).Value = "OK"
   

    If Cells(ActiveCell.Row, I).Interior.ColorIndex = 3 And Cells(ActiveCell.Row, 3).Value <> Cells(ActiveCell.Row - 1, 3).Value Then

            Cells(ActiveCell.Row, 20).Value = "NOK"

    If Cells(4, I).Interior.ColorIndex = 3 Then

            Cells(ActiveCell.Row, 20).Value = "NOK"

    End If
    End If
    End If

    If Cells(ActiveCell.Row, I).Interior.ColorIndex = 3 And Cells(ActiveCell.Row, 3).Value = Cells(ActiveCell.Row - 1, 3).Value Then Cells(ActiveCell.Row, 20).Value = "NOK"

    Next I
    
    If Cells(ActiveCell.Row, 20).Value = "OK" Then
    Cells(ActiveCell.Row, 21).Value = "Validée"
    Call Positionnement
    End If
    
    If Cells(ActiveCell.Row, 20).Value = "NOK" And Cells(ActiveCell.Row, 3).Value <> Cells(ActiveCell.Row - 1, 3).Value Then
    MsgBox " Démonter le produit et refaire les mesures !", vbCritical + vbOKOnly, "Résultat des mesures"
    Call Positionnement
    End If
    
    If Cells(ActiveCell.Row, 20).Value = "NOK" And Cells(ActiveCell.Row, 3).Value = Cells(ActiveCell.Row - 1, 3).Value Then
    MsgBox "Mesure non valide, appeler le responsable qualité !", vbCritical + vbOKOnly, "Validation des mesures"
    Call Positionnement
    End If
       
    

    Else

   For I = 4 To 19
        
       
        
        'si la couleur de la cellule en cours est différente de vert, NOK et fin !
        If Cells(ActiveCell.Row, I).Interior.ColorIndex <> 4 And Cells(ActiveCell.Row, 3).Value <> Cells(ActiveCell.Row - 1, 3).Value Then
        
            Cells(ActiveCell.Row, 20).Value = "NOK"
                        
            
        If Cells(4, I).Interior.ColorIndex <> 4 Then
        
            Cells(ActiveCell.Row, 20).Value = "NOK"
                
            End If
            End If

            
        If Cells(ActiveCell.Row, I).Interior.ColorIndex <> 4 And Cells(ActiveCell.Row, 3).Value = Cells(ActiveCell.Row - 1, 3).Value Then Cells(ActiveCell.Row, 20).Value = "NOK"

            
  Next I

    If Cells(ActiveCell.Row, 20).Value = "OK" Then
    Cells(ActiveCell.Row, 21).Value = "Validée"
    Call Positionnement
    End If
    
    If Cells(ActiveCell.Row, 20).Value = "NOK" And Cells(ActiveCell.Row, 3).Value <> Cells(ActiveCell.Row - 1, 3).Value Then
    MsgBox " Démonter le produit et refaire les mesures !", vbCritical + vbOKOnly, "Résultat des mesures"
    Call Positionnement
    End If
    
    If Cells(ActiveCell.Row, 20).Value = "NOK" And Cells(ActiveCell.Row, 3).Value = Cells(ActiveCell.Row - 1, 3).Value Then
    MsgBox "Mesure non valide, appeler le responsable qualité !", vbCritical + vbOKOnly, "Validation des mesures"
    Call Positionnement
    End If
    
End If
End If
'End If


    
End Sub


Merci d'avance :mrgreen:
g
gyrus
Membre fidèle
Membre fidèle
Messages : 311
Appréciations reçues : 43
Inscrit le : 8 avril 2019
Version d'Excel : 2013 FR

Message par gyrus » 23 septembre 2019, 17:45

Bonjour,

La feuille étant protégée, la cellule ne peut pas être renseignée ...

Cordialement.
P
Papi27190
Membre habitué
Membre habitué
Messages : 84
Inscrit le : 30 octobre 2017
Version d'Excel : 2013 EN

Message par Papi27190 » 24 septembre 2019, 15:10

Bonjour, en effet le problème provient bien du verrouillage du fichier...

Après de nombreux essais, je suis à nouveau "bloqué".

Je cherche à mettre en place une fonction de verrouillage. Celle-ci doit empêcher toutes modifications de cellules non vides (protégées via un mot de passe), tandis que les cellules vides sont accessible sans mot de passe.

Mon programme fonctionne ligne après ligne ( 21 colonnes par ligne)

Le fichier est assez lourd d'utilisation : je le met en pièce jointe si jamais cela peux aider.

Merci d'avance
Programme DAB 402B t.xlsm
(173.14 Kio) Téléchargé 3 fois
g
gyrus
Membre fidèle
Membre fidèle
Messages : 311
Appréciations reçues : 43
Inscrit le : 8 avril 2019
Version d'Excel : 2013 FR

Message par gyrus » 24 septembre 2019, 15:24

Bonjour,

Je te confirme que le verrouillage du projet fonctionne bien.
Le code est inaccessible.

:¬OL:

Cordialement.
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message