Couleur

Résolu
mic6259 Messages postés 371 Statut Membre -  
 mic6259 -
Bonjour
Dans le fichier joint, dans Jeu après un clic sur nouvelle partie puis nouveau tirage,des n°s s'affiche dans R2 dont j'ai mis une forme double ronde, est-il possible de changer la couleur bleu quand un chiffre apparaît de 1 a 15 puis une autre couleur de 16 a 30 comme çà jusqu'à 90(de 15 en 15)
Merci
https://www.cjoint.com/c/EEqqa4RaDVj

6 réponses

  1. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Bonsoir,

    Tu pourrais accélérer ton code en le simplifiant, mais si tu veux coloriser le cercle tu peux ajouter juste avant End Sub du code "gagnants" ces lignes
    et le code gagnants devrait être dans un module plutôt que dans les propriétés de ta feuille ou intégré dans le code d'un bouton

    If Application.CountA(Range("A2" & ":A" & [A65536].End(xlUp).Row)) > 1 Then _
    ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 4
    If Application.CountA(Range("A2" & ":A" & [A65536].End(xlUp).Row)) > 15 Then _
    ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 6
    If Application.CountA(Range("A2" & ":A" & [A65536].End(xlUp).Row)) > 30 Then _
    ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 7
    If Application.CountA(Range("A2" & ":A" & [A65536].End(xlUp).Row)) > 45 Then _
    ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 28
    If Application.CountA(Range("A2" & ":A" & [A65536].End(xlUp).Row)) > 60 Then _
    ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 8
    If Application.CountA(Range("A2" & ":A" & [A65536].End(xlUp).Row)) >= 75 Then _
    ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 3
    0
  2. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Re,

    je n'avais pas remarqué que G2 comptait les tirages, dans ce cas tu peux remplacer mes lignes par

    If Range(celnum) > 1 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 4
    If Range(celnum) > 15 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 6
    If Range(celnum) > 30 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 7
    If Range(celnum) > 45 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 28
    If Range(celnum) > 60 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 8
    If Range(celnum) >= 75 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 3
    0
    1. mic6259
       
      Bonjour Mike-31
      Oui j'avais remarque ce problème,car il faut en effet que la couleur change en fonction du numéro tiré au sort.Je vais essayer et remplacer le lignes
      Merci beaucoup
      0
    2. mic6259
       
      Bonjour Mike-31
      Un petit souci car ce n'est pas tout à fait çe que je veux.
      Le principe c'est d avoir le numéro 1-2-3.....etc jusqu'au 15 une couleur le 16-17...jusqu'àu 30 une autre couleur etc.

      Si le 10 est tiré au sort la couleur par exemple color=6 ensuite si le suivant est le 29 la couleur doit changer a Color=7 ainsi de suite.
      Excusez moi du dérangement.
      Merci
      0
  3. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Re,

    Supprime tes Mises en forme conditionnelle dans le code "gagnants" juste avant End Sub colle ce code à la place de mes propositions précédentes

    If Range("A65535").End(xlUp) > 1 Then [H2].Font.ColorIndex = 4
    If Range("A65535").End(xlUp) > 15 Then [H2].Font.ColorIndex = 6
    If Range("A65535").End(xlUp) > 30 Then [H2].Font.ColorIndex = 7
    If Range("A65535").End(xlUp) > 45 Then [H2].Font.ColorIndex = 28
    If Range("A65535").End(xlUp) > 60 Then [H2].Font.ColorIndex = 8
    If Range("A65535").End(xlUp) >= 75 Then [H2].Font.ColorIndex = 3

    par contre je n'ai pas enregistré ton fichier et ton lien n'est plus valide, peux tu remettre le lien de ton fichier que je vois ce qui est possible de faire

    A+
    Mike-31

    Une période d'échec est un moment rêvé pour semer les graines du savoir.
    0
    1. mic6259
       
      Bonjour
      Excusez moi problème Internet
      La dernière macro ne color que les numéros affichés dans h2 est-il possible de colorée que la bouée 2?
      j envoie le fichier des que je peut.
      0
  4. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Re,

    coloration uniquement de la Bouée2

    If Range("A65535").End(xlUp) >= 1 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 4
    If Range("A65535").End(xlUp) > 15 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 6
    If Range("A65535").End(xlUp) > 30 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 7
    If Range("A65535").End(xlUp) > 45 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 28
    If Range("A65535").End(xlUp) > 60 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 8
    If Range("A65535").End(xlUp) >= 75 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 3
    0
    1. mic6259 Messages postés 371 Statut Membre 1
       
      Bonjour
      Voici le fichier
      Il faut mettre les couleurs en fonction des chiffres et non pas en fonction du nombre de tirage. Les chiffres tirés au sort de 1 a 15 couleur 4 les chiffres de 16 a 30 couleur 7 etc jusqu'a 90.
      Est-ce que la macro que tu a mis est la bonne.
      Je vais essayer

      https://www.cjoint.com/c/EEBkXbwJ74C
      0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Re,

    et bien dans ta macro "gagnants" il suffit de changer ces lignes

    If Range(celnum) > 1 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 4
    If Range(celnum) > 15 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 6
    If Range(celnum) > 30 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 7
    If Range(celnum) > 45 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 28
    If Range(celnum) > 60 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 8
    If Range(celnum) > 75 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 3

    par le code que je t'ai donné dans mon dernier post

    If Range("A65535").End(xlUp) >= 1 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 4
    If Range("A65535").End(xlUp) > 15 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 6
    If Range("A65535").End(xlUp) > 30 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 7
    If Range("A65535").End(xlUp) > 45 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 28
    If Range("A65535").End(xlUp) > 60 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 8
    If Range("A65535").End(xlUp) >= 75 Then ActiveSheet.Shapes("Bouée 2").DrawingObject.Interior.ColorIndex = 3

    ensuite si tu ne veux pas que les numéros tirés changent de couleur, il suffit de supprimer les mises en forme conditionnelle que tu as créé
    0
    1. mic6259 Messages postés 371 Statut Membre 1
       
      Bonjour Mike-31
      Je vais vous embêter encore un peut.
      La dernière macro fonctionne très bien.
      J'ai crée un autre fichier ici présent avec les mêmes macro et j'ai fais comme vous avez dit,mais il y a une erreur.
      J'ai essayé de comprendre d'ou viendrait l'erreur -pas moyen.
      Pourtant c'est les même macros..
      Pourriez-vous m'expliquer ce problème, car j'ai aussi d'autre fichiers(Bingos) a faire.
      Ne pas oublier de cliquer avant sur nouvelle partie avant de faire nouveau tirage.
      Merci beaucoup

      https://www.cjoint.com/c/EEDhkozhJ74
      0
  7. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Re,

    Normal, tu as refait ton fichier et également ta bouée, à l'origine ta bouée était la deuxième créé et était nommée Bouée2

    tu as fait plusieurs essaies et sur ton fichier la bouée est nommée Bouée 7 il faut donc revoir ton code et changer le nom de bouée 2 par Bouée 7

    If Range("A65535").End(xlUp) >= 1 Then ActiveSheet.Shapes("Bouée 7").DrawingObject.Interior.ColorIndex = 4
    If Range("A65535").End(xlUp) > 15 Then ActiveSheet.Shapes("Bouée 7").DrawingObject.Interior.ColorIndex = 6
    If Range("A65535").End(xlUp) > 30 Then ActiveSheet.Shapes("Bouée 7").DrawingObject.Interior.ColorIndex = 7
    If Range("A65535").End(xlUp) > 45 Then ActiveSheet.Shapes("Bouée 7").DrawingObject.Interior.ColorIndex = 28
    If Range("A65535").End(xlUp) > 60 Then ActiveSheet.Shapes("Bouée 7").DrawingObject.Interior.ColorIndex = 8
    If Range("A65535").End(xlUp) >= 75 Then ActiveSheet.Shapes("Bouée 7").DrawingObject.Interior.ColorIndex = 3
    0
    1. mic6259
       
      Merci beaucoup
      0