Autres Mise en forme déficiente après ajouts de lignes...

mychance

XLDnaute Nouveau
Bonjour,

Je veux d'abord dire que je trouve formidable les gens qui composent ce forum. À chaque fois que j'ai soumis une requête, les réponses ont toujours été rapides et surtout très efficaces. Je suis très impressionné !!!

Je vous soumets aujourd'hui une feuille que j'ai montée il y a quelques années grâce l'aide d'un collaborateur de ce forum. Mon problème aujourd'hui est que j'ai dû ajouter 3 lignes et que la mise en forme automatique, dans ce cas la couleur de la cellule, s'est perdue lors de la sélection dans la liste déroulante. Si on sélectionne un item dans E29, par exemple, la case change de couleur, et lorsque que je sélectionne dans la case E30, la case reste blanche. J'ai cherché du côté de la mise en forme conditionnelle et je n'ai rien trouvé. J'ai tenté églament le copié-collé en ôtant la protection de la feuille, sans plus de succès.

Merci à l'avance !
 

Pièces jointes

  • Répartition de tâche - Version Oct. 2020 COVID.xls
    90 KB · Affichages: 12

goube

XLDnaute Impliqué
Bonjour,

Ta mise en forme est issue d'une macro.

VB:
Option Explicit
'========================================================
'===            Mise en forme des tâches              ===
'========================================================
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim temoin As Boolean
    Dim Ref As Variant
    Dim dl As Integer

    dl = Range("b12").End(xlDown).Row
    
    ActiveSheet.Protect UserInterfaceOnly:=True    'protection autorisant les actions de ma macro

    If Not Intersect(Target, Range("E10:X" & dl)) Is Nothing And Target.Count = 1 And Not temoin Then  'test1
        temoin = True
        Target.Interior.ColorIndex = xlNone
        For Each Ref In Range("Valid")
            If UCase(Target.Value) = UCase(Ref.Value) Then    'test2
                Target.Interior.ColorIndex = Ref.Interior.ColorIndex
            End If    'test2
        Next Ref
        temoin = False
    End If    'test1
End Sub

Il faut remplacer la plage Range("E10:X29) par Range("E10:X" & dl) où dl représente la dernière ligne de ton tableau B12:X32.
Code:
  dl = Range("b12").End(xlDown).Row
Cordialement.
 

Pièces jointes

  • Répartition de tâche - Version Oct. 2020 COVID.xls
    92.5 KB · Affichages: 2

soan

XLDnaute Barbatruc
Inactif
Bonjour @mychance, goube,

Je te retourne ton fichier modifié.

C'est sympa, les noms définis de ton Gestionnaire de noms :

Image 1.jpg


2 noms en double ; 2 #REF! ; j'espère que tu m'en voudras pas trop si j'ai un peu allégé :

Image 2.jpg


oh la ! j't'entends d'ici : « et mon nom défini Valid, il est passé où ? » ; oh, ben il est juste passé
à la trappe ! mais t'inquiètes pas, c'est pas grave : ta nouvelle macro ne s'en sert plus ! ;)

d'ailleurs, elle ne se sert pas non plus de ta variable temoin ; ni de ta variable Ref ; ni de ton
Range("Valid"). :p que dis-tu ? tu demandes : « c'est tout, oui ? y'a pas aut' chose que t'as
enlevé, par hasard ? » :eek: euh, ben en fait, j'ai failli supprimer aussi ton UserForm2, inutile,
car il est vide (il ne contient aucun bouton, ni autre contrôle), et ce UserForm2 ne contient
aucun code de formulaire ; mais bon, par pure générosité, et dans ma grande bonté d'âme,
j'ai quand même décidé de le laisser, à tout hasard, au cas où tu aurais prévu de peut-être
le compléter ensuite ; mais si tel n'est pas le cas, je t'assure que ton UserForm2 entièrement
vide
ne sert strictement à rien, donc tu peux faire le ménage, et le supprimer toi-même !

bon, si nous en venions à nos moutons ? je veux dire ta macro Worksheet_Change() ; je te
laisse faire des tests sur ta feuille de calcul "2017" (déjà vieille de 3 ans) ... alors ? c'est ok ?
ça marche bien comme tu veux ? donc fais Alt F11 : tu pourras voir ce code VBA :


VB:
Option Explicit: Option Compare Text

'========================================================
'===            Mise en forme des tâches              ===
'========================================================

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim nlm&, dlg&, lig&, vx$
  With Target
    If .CountLarge > 1 Then Exit Sub
    nlm = Rows.Count: dlg = Cells(nlm, 2).End(3).Row - 3: If dlg = 12 Then Exit Sub
    If Intersect(Target, Range("E13:X" & dlg)) Is Nothing Then Exit Sub
    ActiveSheet.Protect UserInterfaceOnly:=True 'protection interface
    Application.ScreenUpdating = 0: .Interior.ColorIndex = -4142
    vx = .Value: If vx = "" Then Exit Sub
    dlg = Cells(nlm, 26).End(3).Row
    For lig = 15 To dlg
      If vx = Cells(lig, 26) Then _
        .Interior.ColorIndex = Cells(lig, 26).Interior.ColorIndex
    Next lig
  End With
End Sub
j'ai mis : Range("E13:X" & dlg) ; ce n'est pas à partir de E10 ! (n'est-ce pas @goube ? ;)) ;
de plus, le dl = Range("b12").End(xlDown).Row de @goube marchera correctement si et
seulement si il n'y a jamais de cellule vide dans B13:B32 ; c'est pourquoi, par précaution,
j'ai choisi cette autre méthode : dlg = Cells(nlm, 2).End(3).Row - 3 : le .End(3) tombera sur
la cellule qui contient "Pourcentage tâche : " (j'ai ajouté un espace à droite pour éviter que ce texte
soit trop collé contre le bord droit de la cellule)
; puis la ligne de cette cellule moins 3 = ligne de la
dernière cellule de ton tableau ; ici : 35 - 3 = 32 ; vu ? :)

il y a aussi dlg = Cells(nlm, 26).End(3).Row : dernière cellule utilisée, selon la colonne Z ;
ça, c'est ce qui a servi à remplacer ton feu ex-nom défini Valid (paix à son âme : il a rejoint les
limbes du VBA, quelque part entre Ciel et Terre)
; même si tu ajoutes d'autres valeurs sous "Ang"
de Z30, elles seront prises en compte ; par contre, c'est prévu qu'ça commence toujours
en Z15 ; comment ? tu dis : « non, pas en Z15 ! ça commence en Z14 ! » ; exact, tout à
fait exact ; mais comme Z14 est vide et ne contient aucun texte, c'est tout à fait inutile
de le tester, pas vrai ? ;) donc : For lig = 15 To dlg (c'est bien c'que j'disais ! :p).

ne change surtout pas le 3 des deux .End(3) : ça équivaut à .End(xlUp) : vers le haut ;
c'est pareil, mais simplement, c'est à la fois plus court à écrire et à lire.

ah, j'me disais bien qu'j'avais supprimé encore aut'chose : tes 2 UCase() ; pas la peine de
les remettre, hein ? ça marchera tout aussi bien sans, car à droite de Option Explicit, j'ai
ajouté : Option Compare Text ; tu trouveras bien dans l'Aide VBA de quoi il s'agit. :D

si tu as besoin d'une adaptation ou d'un complément d'info, tu peux demander ;
à te lire pour avoir ton avis. :)


soan
 

Pièces jointes

  • Répartition de tâche - Version Oct. 2020 COVID.xls
    90.5 KB · Affichages: 4
Dernière édition:

mychance

XLDnaute Nouveau
Un ÉNORME MERCI Soan !!! Je suis très content du résultat. La macro avait été faite par un membre du forum car je n'y connais absolument rien. Du coup, vos explications vont me permettrent de faire des ajustements pour les éventuels changements futurs.

Merci encore !

Mychance
 

Discussions similaires

Réponses
12
Affichages
195

Statistiques des forums

Discussions
312 070
Messages
2 085 045
Membres
102 766
dernier inscrit
Awiix