Résolu Couleur d'onglet conditonnelle

[GTmacrodeb]

Bonjour à toute la communauté,

Je viens demander de l’aide car je ne parviens pas à réaliser une macro.

J’ai un fichier Excel dans lequel j’ai plusieurs feuilles dont certaines sont numérotées de 1 à 200 (correspond au nom de chaque feuille).

Je souhaite colorier l’onglet lorsque sur la feuille correspondante, la cellule H8 est complétée.

Voici les prémices du code que j’ai tenté :

Option Explicit

Sub CouleurOnglet()

Dim ws_1 As Worksheet

Set ws_1 = Worksheets("1")

If ws_1.Range("H8").Value <> "" Then
    ws_1.Tab.ColorIndex = 4

End If

End Sub

Plusieurs questions :
1- comment faire pour que ce code s’applique à l’ensemble de mes feuilles numérotées de 1 à 200 sans passer par un copier/coller de cette formule (199 fois) ?
2- comment rendre cette macro automatique, c'est-à-dire qu’elle s’éxécute sans passer par une action « click » ?
3- actuellement avec ce code, lorsque j’efface le contenu de la cellule H8, l’onglet reste colorié en vert, existe-t-il un moyen pour qu’il retrouve la couleur par défaut ?

Merci d’avance pour votre aide.

 

[zeb]

Salut GTmacrodeb

Tu peux mettre tes macros dans le code des feuilles, dans celui du classeur ou dans un module.
Dans ton cas, je te propose de mettre ta coloreuse d'onglet dans le code du classeur.

Et à chaque changement dans une quelconque feuille, vérifier s'il faut colorer l'onglet.
Comment ?
En instanciant la méthode Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Excel te donne tout : la feuille et la cellule.

Pour décolorer un onglet de feuille, il te faut mettre une certaine valeur que je te laisse découvrir :
Pour un nouveau classeur, dans la fenêtre Exécution [Ctrl+G] de VB, tape la commande suivante, suivie de [Entrée]

? Feuil1.Tab.ColorIndex

C'est ce que tu cherchais ?

 

[GTmacrodeb]

Bonjour Zeb et d'abord merci pour tes conseils avisés.

Voici le code que j'ai pu créer à partir de ton aide :

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

If Range("F8").Value <> "" Then
    Sh.Tab.ColorIndex = 4
    MsgBox "Votre devis a été facturé"
End If

If Range("F8").Value = "" Then
    Sh.Tab.ColorIndex = -4142
End If

End Sub

Ce code fonctionne bien, mon seul souci c'est que cela ralentit "considérablement" les modifications sur ma feuille, avec un message "recalcul" dans la barre d'état.

Je suis sûrement un peu difficile et peut-être que cela est dû aux capacités de mon PC, mais je suis preneur s'il y a un moyen d'améliorer cette phase.

Merci encore !

edit1 : après quelques essais, je m'aperçois qu'à partir du moment où j'ai mis une valeur en "F8", dès que je change une autre cellule j'ai la MsgBox qui s'ouvre. Je souhaiterais que cette fenêtre s'affiche uniquement lorsque l'on rentre une valeur dans "F8". Par conséquent, il est possible que cela soit ce paramètre qui ralentisse également le fichier car lorsque "F8" est vide sur ma feuille, le "calcul" se fait plus rapidement.

 

[zeb]

Salut,

LOL

Alors avant de te donner la solution à ton GROS problème de performance, je vais faire en sorte que tu trouves tout seul.
Mais tu peux donner ta langue au chat....

Relis aussi ce que ce te disais :

Salut GTmacrodeb

Tu peux mettre tes macros dans le code des feuilles, dans celui du classeur ou dans un module.
Dans ton cas, je te propose de mettre ta coloreuse d'onglet dans le code du classeur.

Et à chaque changement dans une quelconque feuille, vérifier s'il faut colorer l'onglet.
Comment ?
En instanciant la méthode Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Excel te donne tout : la feuille et la cellule.

Pour décolorer un onglet de feuille, il te faut mettre une certaine valeur que je te laisse découvrir :
Pour un nouveau classeur, dans la fenêtre Exécution [Ctrl+G] de VB, tape la commande suivante, suivie de [Entrée]

? Feuil1.Tab.ColorIndex

C'est ce que tu cherchais ?

 

[GTmacrodeb]

Quand je vois ton LOL en majuscule, je me dis qu'il y a encore du boulot !!!

Je ne souhaite évidemment pas donner ma langue au chat mais je suis cependant à la recherche de pistes pour avancer sur ce code. Je pense que tu m'en as données dans ton message précédent mais je ne parviens pas à les interpréter :/:??:

Faut-il appeler une autre macro dans le cas où la condition est remplie ?
Faut-il que j'utilise une propriété du type Application.EnableEvents pour que la macro ne s'exécute que sous certaines conditions ?

Dernier point, Excel ne me donne pas tout chez moi (malheureusement), il faut que je lui demande ou que je l'invite au moins à me le donner de manière plus explicite...

 

[zeb]

As-tu lu l'aide sur Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) ?
C'est le point de départ quand on te donne le nom d'une fonction comme solution.
Juste un petit détail. Il faut chercher à SheetChange, événement.

On peut y lire explicitement :

Sh Objet Worksheet qui représente la feuille.
Source Plage modifiée.

Et c'est justement ce dont nous avons besoin.
Ton code est exécuté au moindre changement, sur toutes les feuilles, sur toutes les cellules.
C'est beaucoup.

Restreignons-nous à la feuille 1, et à la cellule F8 !

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

If Sh.Index = 1 And Target.Address = "$F$8" Then
    If Target.Value <> ""
        Sh.Tab.ColorIndex = 4
        MsgBox "Votre devis a été facturé"
    Else
      Sh.Tab.ColorIndex = -4142
    End If
End If

End Sub

Bon, maintenant, réfléchis à comment tu auras pu trouver tout seul avec le peu que je t'avais laissé.

Re-LOL

 

[GTmacrodeb]

J'ai effectivement cherché l'aide en faisant F1 sur mon clavier mais il ne m'a rien indiqué sur la partie Workbook_SheetChange, j'ai par contre bien accédé à la rubrique SheetChange, évènement comme tu m'y as si gentiment invité.

Je reposte cependant ton code que j'ai légèrement modifié :

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

If Target.Address = "$F$8" Then
    If Target.Value <> "" Then
        Sh.Tab.ColorIndex = 4
        MsgBox "Votre devis a été facturé"
    Else
        Sh.Tab.ColorIndex = -4142
    End If
End If

End Sub

Première remarque, je pense qu'il devait manquer la liaison Then dans ton code ligne 4.

Deuxième remarque, dans ma demande initiale j'avais précisé que cette formule devait s'appliquer à l'ensemble des feuilles numérotées de 1 à 200 (il pourrait y en avoir plus). J'ai deux feuilles qui sont au départ du classeur et qui sont nommées différemment et pour lesquelles je ne souhaite pas que cette macro s'applique.
Actuellement avec ce code, la macro fonctionne correctement et ne s'applique pas sur ces feuilles car soit la cellule "F8" est vide soit elle est déjà complétée avec une formule et la feuille est protégée par conséquent aucune modification n'est réalisée.

Est-il nécessaire/judicieux d'effectuer des aménagements dans le code ?

 

[zeb]

Ah, merci, merci, merci. Pour ton état d'esprit. Bien des gens seraient restés bloqués parce que j'ai oublié le Then !

Par principe, tu dois préciser les feuilles, car c'est un hasard que les autres feuilles n'aient pas de valeur en F8. Et tu pourrais être amené à changer d'avis.

Voici un exemple de test judicieux :

If Target.Address = "$F$8" And IsNumeric(Sh.Name) And 1 <= CInt(Sh.Name) And CInt(Sh.Name) <= 200 Then

N'aie pas peur de multiplier les tests, les performances ne devraient pas en souffrir. Mais attention à l'ordre dans lequel tu les mets. Pour quelques 200 feuilles, tu as plus de 3 milliards de cellules ! En vérifiant d'abord l'adresse de la cellule puis le nom de la feuille, tu divises par 16 millions puis par 200. En effet, dans une clause If pleine de And, si le premier test est faux, les autres ne sont pas vérifié.

-------------------

ARRETE DE FAIRE DU XML !!!!! :fou: :fou: :fou:
(N'écris pas [code=XML], mais [code=VB])

 

[GTmacrodeb]

Bonjour Zeb,

J’ai bien pris en compte tes remarques, par contre il ne me semble pas nécessaire de préciser la « tranche numérique » dans laquelle le nom de la feuille est située étant donné que dans mon classeur je souhaite que ma macro s’applique à toutes les feuilles dont le nom est un numéro et que ce chiffre sera amené à varier.

Ensuite, y a-t-il un intérêt (au niveau performance) à placer les 2 conditions If successivement en ligne 3 et 4 de la macro précédente. Suite à tes remarques, je les mises sur une même ligne avec l'opérateur And.

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

If Target.Address = "$F$8" And Target.Value <> "" And IsNumeric(Sh.Name) Then
    Sh.Tab.ColorIndex = 4
    MsgBox "Votre devis a été facturé"
Else
    Sh.Tab.ColorIndex = -4142
End If

End Sub

Avec cette macro, je ne rencontre aucun souci et elle correspond exactement à mon besoin.

Merci de me confirmer si ce code est optimisé ou si des modifications sont encore à apporter.

 

[zeb]

M'enfin !
Je croyais que tu étais victime de lenteur ?

Avec le code que tu proposes, la clause Else va être exécutée au moindre changement dans tes cellules.
Donc non, ce n'est pas bon.

La clause Then par contre est bonne. Si le test IsNumeric() est suffisant, pas de problème.

Voici le code complet qu'il faudrait exécuter :

If Target.Address = "$F$8" And Target.Value <> "" And IsNumeric(Sh.Name) Then
  Sh.Tab.ColorIndex = 4
  MsgBox "Votre devis a été facturé"
End If

If Target.Address = "$F$8" And Target.Value = "" And IsNumeric(Sh.Name) Then
  Sh.Tab.ColorIndex = -4142
End If

En factorisant tout ça, on obtient bien :

If Target.Address = "$F$8" And IsNumeric(Sh.Index) Then
    If Target.Value <> "" Then
        Sh.Tab.ColorIndex = 4
        MsgBox "Votre devis a été facturé"
    Else
        Sh.Tab.ColorIndex = -4142
    End If
End If

Est-ce maintenant bien clair pour toi ?

 

[GTmacrodeb]

C'est clair sur le principe mais je ne comprends pas pourquoi tu as inversé les clauses And dans la 1ère ligne car il vaut mieux vérifier d'abord l'adresse de la cellule puis le nom des feuilles dans un souci de performance selon tes explications précédentes.

Non ? :/

 

[zeb]

Relis mieux mon code !
.
.
.
.
.
.
.
.
.
[atch]

 

[GTmacrodeb]

Je préfère ! (Merci la fonction Edit)

Il manque juste le Then à la fin de la ligne 2 et le sujet sera clos ...

Merci pour tout !

 

[zeb]

>> Je préfère [..] Il manque juste ...
:heink:
[atch]

>> Merci la fonction Edit



>> et le sujet sera clos
Ah non !
C'est à toi de signifier que le sujet est résolu, en choisissant parmi les messages celui qui aura apporté la meilleure soluce.
(Choisis donc le moins mauvais de mes messages )