XL 2016 MFC sur plusieurs critères

Lorenzini · 24 Juillet 2024

Bonjour,

N'ayant plus de solutions (vu mon niveau limité en vba car j'imagine qu'il va falloir passer par là...), je me tourne vers vous car je patauge.
Dans le petit tableau que j'ai joins à ce message, je souhaiterais que le statut d'une ligne prévale sur le(s) statut(s) d'une/des autre(s) ligne(s) ; je donne qq exemples pour illustrer :

En changeant le statut (j'ai fais une MFC) d' "en cours" à "prêt" de la ligne 24 p.ex., je cherche à ce que

- toutes les lignes précédentes du tableau (jusqu'à celles qui avaient le statut "prêt" ; c'est la limite, s'il y'en a) ayant le même n° de chariot (colonne G), prennent le même statut.

Concrètement, si clique dans la cellule K24 pour passer d'"en cours" à "prêt", je cherche à ce que les lignes encadrées en rouge (20 et 12 car n° de chariot identique à la ligne 24) se changent à leur tour en "prêt" (et prennent la même mise en forme, couleur).

Autre exemple (qui ajoute encore en difficultés, comme si ce n'était pas assez compliqué comme çà !) :

En changeant le statut "en cours" de la ligne 23, la ligne 18 (qui a le même n° de chariot) se changerait également.

Les difficultés supplémentaires sont que :

1) ici, pour cet exemple, la ligne 10 (qui a aussi un n° de chariot commun) NE DOIT PAS changer car elle a déjà le statut "prêt" !

2) plusieurs de mes collègues seront censés travailler avec ce tableau ; quid si un utilisateur va trop vite et réalise trop tard qu'il a changé le statut d'"en cours" à "prêt" ?
Comment refaire le chemin inverse SANS CHANGER les lignes précédentes qui avaient le même n° de chariot MAIS QUI AVAIT DEJA le statut "prêt" ? (comme la ligne 10)
Il ne faudrait pas qu'en repassant de "prêt" à "en cours", la ligne 10 se change elle aussi de "prêt" à "en cours" !...

Pfff, je ne sais pas si je suis assez clair mais qui que vous soyez, vous aurez déjà été assez courageux d'avoir lu tout ce que j'ai écrit jusqu'ici !

Je vous avoue très honnêtement que çà fait quelques jours que je creuse... je sors tout juste de m'être cassé la tête d'avoir résolu d'autres choses comme le fait qu'Excel ne me recalcule pas l'heure automatiquement... mais là, je ne sais plus !

Si vous pouviez m'aider, j'apprécierai grandement !

Lorenzini · 26 Juillet 2024

crocrocro à dit:

pour les les ######## Il faut simplement élargir la colonne
en pj, nouveau fichier avec le message de confirmation plus petit correctif

VB:

Sub MajStatut(pTarget As Range)
Dim Ligne As Long, nbLigRetour As Long
Dim NouveauStatut
Dim MemoDateMaj As Date
Dim Reponse As Integer
Dim Message As String
Dim LigneEnCours As Boolean

    Application.EnableEvents = False
    MemoDateMaj = Now
    NouveauStatut = pTarget.Value
    Ligne = pTarget.Row - ActiveSheet.Range("Tableau3").Row + 1
    If NouveauStatut = "en cours" Then
        ' on compte le nombre de lignes éventuellemnt concernées pour un retour arrière pour éventuellemnt afficher un message
        nbLigRetour = 0
        For i = 1 To Ligne - 1
            ' on compte les lignes...

crocrocro · 25 Juillet 2024

pour les les ######## Il faut simplement élargir la colonne
en pj, nouveau fichier avec le message de confirmation plus petit correctif

VB:

Sub MajStatut(pTarget As Range)
Dim Ligne As Long, nbLigRetour As Long
Dim NouveauStatut
Dim MemoDateMaj As Date
Dim Reponse As Integer
Dim Message As String
Dim LigneEnCours As Boolean

    Application.EnableEvents = False
    MemoDateMaj = Now
    NouveauStatut = pTarget.Value
    Ligne = pTarget.Row - ActiveSheet.Range("Tableau3").Row + 1
    If NouveauStatut = "en cours" Then
        ' on compte le nombre de lignes éventuellemnt concernées pour un retour arrière pour éventuellemnt afficher un message
        nbLigRetour = 0
        For i = 1 To Ligne - 1
            ' on compte les lignes précédentes qui ont statut "prêt" même n° de chariot et même date maj statut
            If ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = "prêt" And _
                ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1) = ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) And _
                ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = ActiveSheet.Range("Tableau3[Date Statut]").Cells(Ligne, 1) And _
                ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) <> "" Then
                nbLigRetour = nbLigRetour + 1
            End If
        Next i
        If nbLigRetour > 0 Then
            Message = "Il existe " & nbLigRetour + 1 & " lignes avec le n° de chariot " & ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) & vbCrLf _
                    & "Oui pour un Retour au Statut En Cours pour toutes ces lignes" & vbCrLf _
                    & "Non pour un Retour au Statut En Cours uniquement pour la ligne en Cours" & vbCrLf _
                    & "Annuler pour un Retour au Statut En Cours uniquement pour la ligne en Cours"
                    
            Reponse = MsgBox(Message, vbYesNoCancel, "Retour au Statut En Cours")
            Select Case Reponse
                Case vbYes
                    LigneEnCours = False
                Case vbNo
                    LigneEnCours = True
                Case vbCancel
                    ActiveSheet.Range("Tableau3[Statut]").Cells(Ligne, 1) = "prêt"
                    GoTo Fin
            End Select
        End If
    End If
    For i = 1 To Ligne - 1
        ' balayage des lignes précédentes
        'Debug.Print "Statut : " & ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1)
        'Debug.Print "N° chariot : " & ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1)
        'Debug.Print "Service : " & ActiveSheet.Range("Tableau3[Service]").Cells(i, 1)
        
        Select Case True
            Case NouveauStatut = "prêt"
            ' on positionne à "prêt" les lignes précédentes qui ont le même chariot
                If ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) <> NouveauStatut And _
                    ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1) = ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) Then
                    ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = NouveauStatut
                    ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = MemoDateMaj
                End If
            Case NouveauStatut = "en cours"
            ' on positionne à "en cours" les lignes précédentes qui ont statut "prêt" m^me n° e chariot et même date maj statut
                If ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = "prêt" And _
                    ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1) = ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) And _
                    ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = ActiveSheet.Range("Tableau3[Date Statut]").Cells(Ligne, 1) And _
                    ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) <> "" And _
                    Not LigneEnCours Then
                        ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = NouveauStatut
                        ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = MemoDateMaj
                End If
        End Select
    Next i

    ActiveSheet.Range("Tableau3[Date Statut]").Cells(Ligne, 1) = MemoDateMaj
Fin:
    Application.EnableEvents = True
End Sub

Lorenzini · 26 Juillet 2024

crocrocro à dit:

pour les les ######## Il faut simplement élargir la colonne
en pj, nouveau fichier avec le message de confirmation plus petit correctif

VB:

Sub MajStatut(pTarget As Range)
Dim Ligne As Long, nbLigRetour As Long
Dim NouveauStatut
Dim MemoDateMaj As Date
Dim Reponse As Integer
Dim Message As String
Dim LigneEnCours As Boolean

    Application.EnableEvents = False
    MemoDateMaj = Now
    NouveauStatut = pTarget.Value
    Ligne = pTarget.Row - ActiveSheet.Range("Tableau3").Row + 1
    If NouveauStatut = "en cours" Then
        ' on compte le nombre de lignes éventuellemnt concernées pour un retour arrière pour éventuellemnt afficher un message
        nbLigRetour = 0
        For i = 1 To Ligne - 1
            ' on compte les lignes précédentes qui ont statut "prêt" même n° de chariot et même date maj statut
            If ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = "prêt" And _
                ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1) = ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) And _
                ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = ActiveSheet.Range("Tableau3[Date Statut]").Cells(Ligne, 1) And _
                ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) <> "" Then
                nbLigRetour = nbLigRetour + 1
            End If
        Next i
        If nbLigRetour > 0 Then
            Message = "Il existe " & nbLigRetour + 1 & " lignes avec le n° de chariot " & ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) & vbCrLf _
                    & "Oui pour un Retour au Statut En Cours pour toutes ces lignes" & vbCrLf _
                    & "Non pour un Retour au Statut En Cours uniquement pour la ligne en Cours" & vbCrLf _
                    & "Annuler pour un Retour au Statut En Cours uniquement pour la ligne en Cours"
                   
            Reponse = MsgBox(Message, vbYesNoCancel, "Retour au Statut En Cours")
            Select Case Reponse
                Case vbYes
                    LigneEnCours = False
                Case vbNo
                    LigneEnCours = True
                Case vbCancel
                    ActiveSheet.Range("Tableau3[Statut]").Cells(Ligne, 1) = "prêt"
                    GoTo Fin
            End Select
        End If
    End If
    For i = 1 To Ligne - 1
        ' balayage des lignes précédentes
        'Debug.Print "Statut : " & ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1)
        'Debug.Print "N° chariot : " & ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1)
        'Debug.Print "Service : " & ActiveSheet.Range("Tableau3[Service]").Cells(i, 1)
       
        Select Case True
            Case NouveauStatut = "prêt"
            ' on positionne à "prêt" les lignes précédentes qui ont le même chariot
                If ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) <> NouveauStatut And _
                    ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1) = ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) Then
                    ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = NouveauStatut
                    ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = MemoDateMaj
                End If
            Case NouveauStatut = "en cours"
            ' on positionne à "en cours" les lignes précédentes qui ont statut "prêt" m^me n° e chariot et même date maj statut
                If ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = "prêt" And _
                    ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1) = ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) And _
                    ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = ActiveSheet.Range("Tableau3[Date Statut]").Cells(Ligne, 1) And _
                    ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) <> "" And _
                    Not LigneEnCours Then
                        ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = NouveauStatut
                        ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = MemoDateMaj
                End If
        End Select
    Next i

    ActiveSheet.Range("Tableau3[Date Statut]").Cells(Ligne, 1) = MemoDateMaj
Fin:
    Application.EnableEvents = True
End Sub

Beau travail !

Cette dernière solution est le top du top et je vais tâcher de me pencher dessus pour la maîtriser.
J'avoue que j'utilise VBA depuis de nombreuses années et que je ne suis pas du tout familier de la commande debug.print p.ex.
Votre solution est l'idéale !
Merci pour votre sollicitude ; j'aurai été incapable de trouver la solution seul.

Merci !

crocrocro · 26 Juillet 2024

Merci ... pour vos remerciements.
Il y a toujours des choses à apprendre sur Excel.
Pour le débutant bien sûr comme pour celui qui pratique depuis longtemps comme moi.
Bonne continuation.

Lorenzini · 5 Août 2024

crocrocro à dit:
Merci ... pour vos remerciements.
Il y a toujours des choses à apprendre sur Excel.
Pour le débutant bien sûr comme pour celui qui pratique depuis longtemps comme moi.
Bonne continuation.

Bonjour crocrocro,

Je reviens vers vous qui m'avez si bien aidé ...

Je ne sais pas si je dois créer un nouveau contenu ? pour le problème auquel je fais face, mais ll y'a une chose qui est sûre, c'est que celà fait qq jours que je m'arrache les cheveux pour trouver une solution ... sans résultats

Je commence par revenir vers vous car vous vous êtes penché sur mon tableau avec deux propositions de solutions (qui marchent du tonnerre en prime)

Si besoin, je transférerai mon message au reste de la communauté...

Pour faire court : A l'ouverture du fichier, après avoir cliqué sur "lancer le programme", on a le choix entre 2 boutons :

1 ---> Economat
l'autre --> Aides-logistiques

L'idée est de restreindre l'accès au tableau (par ''ScrollArea'') selon le choix effectué.

En cliquant sur ''Aides-logistiques'', on a accès uniquement aux colonnes N à P (cette dernière se remplissant uniquement si N ET O remplis)... jusque-là, tout va bien.
En cliquant sur ''Economat'', on a accès uniquement aux colonnes B à M.

En haut à gauche de la feuille, j'ai ajouté un bouton '+' qui permet d'ajouter une ligne d'encodage au tableau.
En cliquant desssus, ouverture d'une msgbox pour choisir entre 2 options :
soit encoder = 'OUI' --> nouvelle ligne d'encodage... tout va bien
soit encoder = 'NON' --> voilà le problème QUI ME FAIT DEVENIR DINGUE DEPUIS 3 JOURS !!!

Pourquoi la cellule se remplit par une date lorsqu'on choisit 'non' !?!

Si vous pouviez m'aider, ce serait super ; je suis prêt à partager avec d'autres s'il faut, mais mes connaissances rudimentaires (je 'bricole' + que je ne programme véritablement) ne me permettent pas de voir d'où vient le problème ni comment le solutionner...

MERCI d'avance pour toute l'aide que vous pourriez m'apporter

TooFatBoy · 5 Août 2024

Lorenzini à dit:
Si besoin, je transférerai mon message au reste de la communauté...

Coucou on est là...

Lorenzini · 5 Août 2024

TooFatBoy à dit:
Coucou on est là...

Bonjour TooFatBoy

Je suis désespéré car je ne trouve pas de solution à mon problème...
hum hum... j'ai vraiment encore du boulot sur la planche avec VBA

Je présume que vous avez vu le message que j'ai adressé à crocrocro ?

Juste au cas où, le voici :

Pour faire court : A l'ouverture du fichier, après avoir cliqué sur "lancer le programme", on a le choix entre 2 boutons :

1 ---> Economat
l'autre --> Aides-logistiques

L'idée est de restreindre l'accès au tableau (par ''ScrollArea'') selon le choix effectué.

En cliquant sur ''Aides-logistiques'', on a accès uniquement aux colonnes N à P (cette dernière se remplissant uniquement si N ET O remplis)... jusque-là, tout va bien.

En cliquant sur ''Economat'', on a accès uniquement aux colonnes B à M.

En haut à gauche de la feuille, j'ai ajouté un bouton '+' qui permet d'ajouter une ligne d'encodage au tableau.

En cliquant desssus, ouverture d'une msgbox pour choisir entre 2 options :

soit encoder = 'OUI' --> nouvelle ligne d'encodage... tout va bien
soit encoder = 'NON' --> voilà le problème QUI ME FAIT DEVENIR DINGUE DEPUIS 3 JOURS !!!

Pourquoi la cellule se remplit par une date lorsqu'on choisit 'non' !?!

TooFatBoy · 5 Août 2024

Lorenzini à dit:
Je présume que vous avez vu le message que j'ai adressé à crocrocro ?

Évidemment qu'on l'a vu : on est ici sur le forum public, pas en messagerie privée.

Lorenzini · 5 Août 2024

TooFatBoy à dit:
Évidemment qu'on l'a vu : on est ici sur le forum public, pas en messagerie privée.

coooooool

Lorenzini · 5 Août 2024

Lorenzini à dit:
coooooool

...j'ai encore une curiosité que je ne comprends pas !? ...
pourquoi lorsqu'on clique sur le '+' pour ajouter un nouvel encodage, la nouvelle ligne ne prend pas la mise en forme de celle du dessus ?
En gros, pourquoi le tableau ne continue pas une ligne sur 2 en bleu comme les lignes précédentes !?
Quelle est cette curiosité ? Comment y remédier ?

Voir image ci-dessus (ligne 20, 21, ...) ne sont pas comme celles d'avant ; une fois bleue, une fois blanche, ...

Celà peut paraitre une bêtise pour ceux qui sont maîtres d'Excel mais j'avoue que je ne sais pas comment faire en sorte que ces nouvelles lignes soient comme les précédentes !?

TooFatBoy · 5 Août 2024

Lorenzini à dit:
En gros, pourquoi le tableau ne continue pas une ligne sur 2 en bleu comme les lignes précédentes !?
Quelle est cette curiosité ? Comment y remédier ?

Pourquoi ? Parce que la nouvelle ligne n'est pas intégrée au TS.

Comment y remédier ? Mystère.
C'est probablement ta macro qui n'est pas bonne.

Lorenzini · 5 Août 2024

TooFatBoy à dit:
Pourquoi ? Parce que la nouvelle ligne n'est pas intégrée au TS.

Comment y remédier ? Mystère.
C'est probablement ta macro qui n'est pas bonne.

merci pour ce début d'explication que je crois volontiers.
Du coup, je me demande comment intégrer la nouvelle ligne à la macro... la refaire...? je cherche et teste.
Je ne lache pas l'affaire

TooFatBoy · 5 Août 2024

TooFatBoy à dit:
C'est probablement ta macro qui n'est pas bonne.

En fait je crois que ça vient du fait que ta feuille est protégée, donc on ne peut pas ajouter de lignes au TS.

Lorenzini · 5 Août 2024

TooFatBoy à dit:
En fait je crois que ça vient du fait que ta feuille est protégée, donc on ne peut pas ajouter de lignes au TS.

j'y ai pensé aussi mais je viens de vérifier avec une version antérieure (à chaque nouvelle étape, je fais des copies), et là, çà fonctionne ; or il y'a des protections...
C'est vraiment un mystère...

Je note que lorsque je retire ceci :

VB:

If Not Intersect(Range("P7:P100000"), Target) Is Nothing And ActiveCell.Offset(0, -2).Value <> "" And ActiveCell.Offset(0, -1).Value <> "" Then

        'Dim e As Integer

        '    e = ActiveCell.Address
            
        'Range("L1").Value = e

        Range("K1").FormulaR1C1 = "=NOW()"
        Range("K1").NumberFormat = "dd/mm/yyyy  hh""h""mm"
        'Range(Range("L1").Value).Select
        ActiveCell.Value = Range("K1").Text
        Range("K1").ClearContents
        ActiveCell.Offset(1, -2).Select
        
        Dim e As Integer
        Dim f, g As String

            e = ActiveCell.Row
            f = "N" & e
            g = "P100000"
            H = f & ":" & g

        Range("P1").Value = H
        
        ActiveSheet.ScrollArea = H
        
        Range("P1").ClearContents
        
End If

je n'ai plus la date qui s'affiche en colonne 'B' lorsque je choisis non à la boîte de dialogue de confirmation d'ajout d'une ligne...

Lorenzini · 5 Août 2024

Lorenzini à dit:
j'y ai pensé aussi mais je viens de vérifier avec une version antérieure (à chaque nouvelle étape, je fais des copies), et là, çà fonctionne ; or il y'a des protections...
C'est vraiment un mystère...

Je note que lorsque je retire ceci :

VB:

If Not Intersect(Range("P7:P100000"), Target) Is Nothing And ActiveCell.Offset(0, -2).Value <> "" And ActiveCell.Offset(0, -1).Value <> "" Then 'Dim e As Integer ' e = ActiveCell.Address 'Range("L1").Value = e Range("K1").FormulaR1C1 = "=NOW()" Range("K1").NumberFormat = "dd/mm/yyyy hh""h""mm" 'Range(Range("L1").Value).Select ActiveCell.Value = Range("K1").Text Range("K1").ClearContents ActiveCell.Offset(1, -2).Select Dim e As Integer Dim f, g As String e = ActiveCell.Row f = "N" & e g = "P100000" H = f & ":" & g Range("P1").Value = H ActiveSheet.ScrollArea = H Range("P1").ClearContents End If

je n'ai plus la date qui s'affiche en colonne 'B' lorsque je choisis non à la boîte de dialogue de confirmation d'ajout d'une ligne...

par contre, j'ai les accès aux colonnes N, O et P et çà, ce n'est pas ce que je souhaite...
Je voulais limiter l'accès (depuis le bouton ECONOMAT) aux colonnes B à M...

TooFatBoy · 5 Août 2024

C'est normal la Liste déroulante en L25 de la feuille "Feuil1" ???

XL 2016 MFC sur plusieurs critères

Lorenzini

XLDnaute Occasionnel

Pièces jointes

Lorenzini

crocrocro

XLDnaute Impliqué

Pièces jointes

Lorenzini

XLDnaute Occasionnel

crocrocro

XLDnaute Impliqué

Lorenzini

XLDnaute Occasionnel

Pièces jointes

TooFatBoy

XLDnaute Barbatruc

Lorenzini

XLDnaute Occasionnel

Pièces jointes

TooFatBoy

XLDnaute Barbatruc

Lorenzini

XLDnaute Occasionnel

Lorenzini

XLDnaute Occasionnel

TooFatBoy

XLDnaute Barbatruc

Lorenzini

XLDnaute Occasionnel

TooFatBoy

XLDnaute Barbatruc

Lorenzini

XLDnaute Occasionnel

Lorenzini

XLDnaute Occasionnel

TooFatBoy

XLDnaute Barbatruc

Discussions similaires