Changer contenu de cellule en fonction d'une autre cellule en VBA

Le 17/06/2022 à 15:02

Bonjour à toute la communauté,

je me suis déjà rapproché de vous fin février, et aujourd'hui le fichier à encore évolué.

Cependant je bug :

j'aimerai qu'en fonction du choix du niveau testé dans la colonne I (I10:I44) des "coches" soit visibles dans d'autre colonnes !!!

Par exemple si je choisi "2" en I10, je voudrais que Z10, AA10, AB10, AD10, AE10, AG10, AH10 et AI10 soit cochés. Ces cellules appartiennent déjà a des zones pouvant répondre à des doubles clics.

Voici ce que j'ai commencé à faire, mais pas de résultats !!!

Edit modo : code supprimé, merci de le mettre entre balises avec le bouton </>

Merci par avance de l'aide, ou des pistes que vous pourrez me fournir.

Bien cordialement à tout le monde

PS : fichier joint

12test.zip (253.88 Ko)
Le 17/06/2022 à 15:48

Bonjour,

Un essai sur I10?

5test.zip (239.67 Ko)
Le 17/06/2022 à 16:02

Bonjour, Merci beaucoup pour cette rapidité de retour.

malheureusement, cela ne me convient pas, car les zones (Z10:AB44), (AD10:AE44),etc, correspondent à des zones de double clic : quand un double clic est effectuer dans ces zones, la coche apparait et/ou disparait. De ce fait les formules entrée en Z10, Z11... disparaissent au premier double clic et ne reviennent plus :-(

C'est pour cela que je souhaitais progresser avec du code VBA dans la feuille correspondante.

Encore merci de ce coup de main

Le 17/06/2022 à 16:26

Bonjour,

Essayez en remplaçant tout votre code dans la feuille Classe 1 par celui ci-dessous

Option Explicit
Dim stpevt As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Long
Dim ZoneChange As Range

If stpevt = True Then Exit Sub
Set ZoneChange = Range("H10:H44")

If Not Application.Intersect(ZoneChange, Range(Target.Address)) Is Nothing Then
    Application.ScreenUpdating = False
    For i = 10 To 44
        If Cells(i, 9).Value = "" Or Cells(i, 9).Value = "1" Then
            Cells(i, 26).Value = "": Cells(i, 27).Value = "": Cells(i, 28).Value = "": _
            Cells(i, 30).Value = "": Cells(i, 31).Value = "": _
            Cells(i, 33).Value = "": Cells(i, 34).Value = "": Cells(i, 35).Value = ""
        End If
        If Cells(i, 9).Value = "2" Then
            Range(i, 26).Value = "ü": Cells(i, 27).Value = "ü": Cells(i, 28).Value = "ü": _
            Cells(i, 30).Value = "ü": Cells(i, 31).Value = "ü": _
            Cells(i, 33).Value = "ü": Cells(i, 34).Value = "ü": Cells(i, 35).Value = "ü"
        End If
    Next i
    Application.ScreenUpdating = True
End If
If Not Intersect(Target, Range("I10:I" & Range("B" & Rows.Count).End(xlUp).Row)) Is Nothing Then
    If Target.Value = 2 Then
        Application.ScreenUpdating = False
        stpevt = True
        Dim plage As Range, cel As Range
        Set plage = Union(Range("Z10:AB10"), Range("AD10:AE10"), Range("AG10:AI10"))
        For Each cel In plage
            With cel
                .Font.Name = "Wingdings"
                .Font.Size = 20
                If .Value = "" Then .Value = "ü"
            End With
        Next cel
        stpevt = False
    End If
    Application.ScreenUpdating = True
End If
End Sub

Je n'ai considéré que le cas chiffre 2 comme expliqué dans votre demande. Pour effacer c'est le double click dans chaque cellule qui le fait

Cordialement

Le 29/06/2022 à 12:06

Bonjour Dan,

désolé pour ce retour (très) tardif, mais je tiens tout d'abord à te remercier de ta proposition qui me convient bien.

Je reviens vers toi pour quelques compléments :

après plusieurs tentatives (infructueuses) pour mettre en place les cases cochées à la fois dans le stade 1 et le stade 2 quand on sélectionne le passage du niveau 3... puis-je avoir un coup de main s'il vous plaît ? de plus, afin de continuer à progresser en VBA, serait-il possible de disposer de commentaires en fin de ligne, afin de comprendre comme la macro s’exécute ?

Et enfin, j'ai une macro liée au bouton sur chaque feuille qui me permet d'effacer la saisie d'une classe, et depuis la mise en place de ces cases cochées lors d'un changement d'état dans la zone i10:i44, un débogage apparait en relation avec la ligne de code : If target.value = 2 then et je ne comprend pas pourquoi !

merci de votre retour.

Bien cordialement

Richard_37

Le 29/06/2022 à 12:53

Bonjour,

Vu que je n'avais pas de retour j'ai viré le fichier.
Possible de le poster dans l'état où il se trouve actuellement (sans données confidentielles) ?

Crdlt

Le 29/06/2022 à 13:16

Merci beaucoup Dan, voici le fichier

5scolaires-2023.zip (564.84 Ko)
Le 29/06/2022 à 13:58

en y regardant de plus près, il y a pas mal de chose à changer dans le fichier.

En premier, on va corriger le code Nettoie feuille. Faites ceci dans le fichier:
- Supprimez la macro Nettoie feuille dans chaque feuille Classe
- Dans la feuille Classe 1, juste au dessus de cette ligne --> Private Sub Worksheet_Change(ByVal Target As Range), supprimez la valeur DIM Stpevt as boolean
- Allez dans l'éditeur VBA, menu Insertion --> Choisir "Module"
- dans le module, collez l'entièreté du code suivant

Option Explicit
Public stpevt As Boolean
Sub Nettoie_feuille()
' Effacements des données

Application.ScreenUpdating = False
stpevt = True
With ActiveSheet

    .Range("D1:E7").ClearContents
    .Range("H5").ClearContents
    .Range("I5").ClearContents
    .Range("I7").ClearContents
    .Range("C10:I44").ClearContents
    .Range("T10:T44").ClearContents
    .Range("Z10:AB44").ClearContents
    .Range("AD10:AE44").ClearContents
    .Range("AG10:AI44").ClearContents
    .Range("AM10:AR44").ClearContents
    .Range("AU10:AY44").ClearContents

End With
stpevt = False
Application.ScreenUpdating = True
End Sub

- ensuite, Click droite sur chaque bouton "Nettoyage Feuille" et choisir "Affecter une macro", et sélectionnez la macro "Nettoie feuille" dans la liste.
- refaite la même chose pour les autres feuille Classe

NB : veillez à ne pas avoir deux Option explicit mentionné en haut du module sans quoi cela va renvoyer un bug

Dites moi si ok puis je regarde le reste

Le 29/06/2022 à 16:14

me voici de retour après d'autre obligations, c'est chose faite pour la macro de "nettoyage", tout fonctionne sur toute les feuille.

Effectivement, le code est bien plus lisible de cette manière.

Le 29/06/2022 à 17:58

Ok.

En fait en relisant votre code Private Sub Worksheet_Change(ByVal Target As Range) et la partie que vous aviez faites en mettant l'instruction Set Zonechange et ce que je vous ai ajouté, j'ai l'impression que l'on fait deux fois la même chose.

Là votre liste en colonne I comporte 3 valeurs.
Si Ix = 1, vous ne voulez pas de cellules cochées dans la plage "Z10:AB10","AD10:AE10" et "AG10:AI10"
Si Ix = 2, vous voulez cocher dans les cellules de la plage "Z10:AB10","AD10:AE10" et "AG10:AI10"
Si Ix = 3, vous voulez quoi ?
Si Ix est vide (donc = 0), vous voulez quoi ?

Vous pouvez confirmer ma vision ?

Le 29/06/2022 à 18:34

je confirme parfaitement ce que vous visualisez; je complète avec Ix=vide il ne se passe rien, si Ix=1 je ne veut rien, si Ix=2 je veux cocher la zone "Zx:ABx","ADx:AEx","AGx:AIx", et enfin si Ix=3 je veux cocher "Zx:ABx","ADx:AEx","AGx:AIx","AMx:AQx".

Je pense que je me suis mal exprimé en spécifiant le numéro de la ligne dans ma première demande. Effectivement, les zones a cocher si il y a lieu se trouve sur la même ligne que la cellule I qui évolue.

Merci beaucoup.

Le 29/06/2022 à 18:40

je complète avec Ix=vide il ne se passe rien, si Ix=1 je ne veut rien

En fait que ce soit vide ou 1, on ne veut rien. Donc on doit vider les cellules "Zx:ABx","ADx:AEx","AGx:AIx et aussi "AMx:AQx"
Donc là on a gérer une plage en plus
Autre point, ce code doit fonctionne sur toutes les feuilles nommées "Classe x", juste ?

Le 30/06/2022 à 07:32

Bonjour Dan,

perte de réseau depuis hier soir, et donc très impatient de pouvoir retrouver la connexion au plus tôt.

La réponse est oui, le code devrait se dérouler sur toutes les feuilles "Classe x"

Le 30/06/2022 à 09:16

Bonjour

Avant d'aller plus loin, pourriez-vous mettre ce code dans la feuille Classe 1 à la place de celui que vous avez dans votre fichier

Option explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As String

If stpevt = True Then Exit Sub

If Not Intersect(Target, Range("I10:I" & Range("B" & Rows.Count).End(xlUp).Row)) Is Nothing Then
    Application.ScreenUpdating = False
    stpevt = True
    Dim plage As Range, cel As Range, ligne As Byte

    ligne = Target.Row

    Set plage = Union(Range("Z" & ligne & ":AB" & ligne), Range("AD" & ligne & ":AE" & ligne), Range("AG" & ligne & ":Ai" & ligne), Range("AM" & ligne & ":AQ" & ligne)) ', Range("AM" & ligne & ":AQ" & ligne)))
    plage.ClearContents

    Select Case Target.Value
        Case Is = 2
            Set plage = Union(Range("Z" & ligne & ":AB" & ligne), Range("AD" & ligne & ":AE" & ligne), Range("AG" & ligne & ":AI" & ligne))
            i = "ü"
        Case 0 To 1: i = ""
        Case Is = 3: i = "ü"
    End Select

    With plage
        .Font.Name = "Wingdings"
        .Font.Size = 20
        .Value = i
    End With

    stpevt = False
End If
Application.ScreenUpdating = True

End Sub

Faites un test sur cette classe et dites moi si le résultat est celui que vous souhaitez.
Si oui, je vous donnerai la modification à faire pour que le code agisse sur toutes les classes

Le 30/06/2022 à 09:53

Parfais !! SUPER !

C'est exactement le résultat attendu; encore une fois MERCI BEAUCOUP.

Le 30/06/2022 à 12:20

Ok. Parfait.

Avant de vous proposer la modification à faire, quelles sont les feuilles classe qui sont identiques à la feuille Classe1
Là je pensais que toutes les feuilles classes étaient de structure identique mais ce n'est pas le cas

Dites moi

Le 30/06/2022 à 12:47

Avant de mettre toutes les feuilles identiques, je travaillais exclusivement su la feuille "Classe 1".

Pour la facilité de saisie de mes collègues, il y a 10 feuilles identiques à la premières.

Le 30/06/2022 à 13:03

Re,

Ok. Voici ce que vous devez modifier.

- Supprimez toutes les macros Private Sub Worksheet_Change(ByVal Target As Range) que vous avez dans les feuilles Classe
- Allez dans Thisworkbook et mettez le code ci-dessous

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i As String

If stpevt = True Then Exit Sub

If Left(Sh.Name, 6) = "Classe" Then

    If Not Intersect(Target, Range("I10:I" & Range("B" & Rows.Count).End(xlUp).Row)) Is Nothing Then
        Application.ScreenUpdating = False
        stpevt = True
        Dim plage As Range, cel As Range, ligne As Byte

        ligne = Target.Row

        Set plage = Union(Range("Z" & ligne & ":AB" & ligne), Range("AD" & ligne & ":AE" & ligne), Range("AG" & ligne & ":Ai" & ligne), Range("AM" & ligne & ":AQ" & ligne)) ', Range("AM" & ligne & ":AQ" & ligne)))
        plage.ClearContents

        Select Case Target.Value
            Case Is = 2
                Set plage = Union(Range("Z" & ligne & ":AB" & ligne), Range("AD" & ligne & ":AE" & ligne), Range("AG" & ligne & ":AI" & ligne))
                i = "ü"
            Case 0 To 1: i = ""
            Case Is = 3: i = "ü"
        End Select

        With plage
            .Font.Name = "Wingdings"
            .Font.Size = 20
            .Value = i
        End With
            stpevt = False
    End If
End If
Application.ScreenUpdating = True
End Sub

De cette sorte vous aurez un code unique pour toutes les feuilles nommées CLASSE

Si ok après test, je regarderez votre code doubleclick aussi

Le 30/06/2022 à 13:25

YES !!

C'est absolument ça comme finalité. Ne reste plus que les "doubles clic" interractifs sur les zones qui se cochent ou non.

GRAND Bravo et Merci.

Le 30/06/2022 à 15:14

Petite question par rapport au code Change :
Est-ce normal que d'un coté la plage va de AM à AQ et dans le code double click, elle va de AM à AR ?
Idem pour les plages AU:AY et T qui ne sont pas mentionnées dans le code Change

Rechercher des sujets similaires à "changer contenu fonction vba"