Fleches qui changent en fonction de cellule et report dans textbox

Bonjour,

Dans le fichier exemple ci joint, j'aimerais dans un premier temps avoir la possibilite d'avoir des fleches qui changent de sens ( haut/bas) et de couleur(vert/rouge) en fonction de la valeur d'une cellule.

L'ideal serait ensuite de lier ces fleches a des zones de texte situes dans l'onglet suivant.

Cela me semble compliqué sans macro et je suis loin d'être un expert. Quelqu'un saurait m'aider svp ?

Merci par avance

Salut Perico,

Salut le Forum,

Tu trouveras ci-joint ton fichier modifié qui permet de changer l'orientation et la couleur des flèches selon l'évolution indiquée.

Code utilisé :

Sub ArrowDirection()
Dim c, p As Range, i As Long
Set p = Range("F7:H7")
i = 1
For Each c In p
    If c < 0 Then
        ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Rotation = 0
        ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.RGB = RGB(255, 0, 0)
    ElseIf c > 0 Then
        ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Rotation = 180
        ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.RGB = RGB(146, 208, 80)
    ElseIf c = 0 Then
        ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Rotation = 270
        ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
    End If
    i = i + 1
Next c
End Sub

Par contre, pour ta seconde demande [...]

pericoo a écrit :

L'ideal serait ensuite de lier ces fleches a des zones de texte situes dans l'onglet suivant.

[...] j'ai pas compris ce que tu voulais faire

Restant à dispo

Bonjour Juice,

Merci beaucoup.

Serait t-il possible d'avoir les changement automatiquement lorsque la valeur change et sans passer par un bouton d'actualisation.

Pour ce qui est du deuxieme point j'aimerais reporter ces fleches sur un deuxieme onglet dans une zone de texte (qui vont s'actualiser automatiquement en fonction du premier onglet)

Merci pour ton aide

Re-

Quelque point à éclaircir avant de procéder à des modifs :

pericoo a écrit :

Serait t-il possible d'avoir les changement automatiquement lorsque la valeur change et sans passer par un bouton d'actualisation.

Il s'agira d'une modification manuelle ou automatique ?

pericoo a écrit :

Pour ce qui est du deuxieme point j'aimerais reporter ces fleches sur un deuxieme onglet dans une zone de texte (qui vont s'actualiser automatiquement en fonction du premier onglet)

Donc les flèches doivent apparaitre à la fois sur l'onglet 1 et sur l'onglet 2 ?

Si dans l'onglet 1, une flèche est modifiée, alors dans l'onglet 2, la flèche correspondante l'est aussi ?

Re-

Il s'agira d'une modification automatique.

Si les fleches se trouvent seulement sur l'onglet 2 ca me va tres bien.

Cdtl

Re-

Ci-joint ton fichier modifié

J'ai donc supprimé les flèches de l'onglet 1 car inutile, et rendu automatique l'orientation et la couleur des flèches selon l'évolution indiquée

Je te laisse tester et revenir vers nous

Merci, c'est exactement ce que je recherche.

Cependant cela ne fonctionne pas lorsque j'essaie d'appliquer le code a mon fichier.

La "range" a bien ete modifie , cependant j'ai un doute sur l'ActiveSheet a mettre dans le code.

J'obtient le message d'erreur suivant:

Run time error 1004: the item with specified name wasn't found

Merci d'avance pour ton retour

Re-

pericoo a écrit :

La "range" a bien ete modifie , cependant j'ai un doute sur l'ActiveSheet a mettre dans le code.

J'obtient le message d'erreur suivant:

Il ne s'agit plus d'un ActiveSheet mais d'un Sheets(x)

Au vue du message d'erreur, je dirais plutôt que se sont les noms qui diffèrent de tes flèches (ex: "Arrow: Down " & i) entre ton fichier test et ton fichier principal.

Il faut que tu cherche le nom de ces flèches et que tu le modifie dans le code

A dispo

RE-

Je rencontre toujours le meme probleme, pourtant je me suis assure de changer le nom des fleches sur mon onglet pour matcher avec le code , j'ai utilise les memes noms que sur le fichier test.

Le bug intervient seulement sur la derniere partie en 4eme ligne

 ElseIf c = 0 Then
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Rotation = 270
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        Sheets(11).Shapes.Range(Array("Arrow: Down " & i)).Rotation = 270
        Sheets(11).Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
    End If

L'erreur nous indique bien que l'objet Shape n'a pas été trouvé :

Tu a compris comment fonctionnais le code avec le système de la Boucle i et "Arrow: Down " & i ?

Avec l'importation du code dans ton fichier tu n'a pas modifié quelque chose ? Par exemple :

Set p = Range("F7:H7")

A chaque fois que la boucle à fais un tour, elle rajoute +1 à la variable i ce qui permet de passer à la Shape suivante.

Si tu a modifié quelque chose et que la boucle tourne une fois de trop, alors elle ne trouvera pas le Shape correspondant

Enfin, est-ce que tu a toujours que 3 Shape ou est ce que tu en a rajouté ?

A dispo

Effectivement, j'ai modifie la range dans le code pour matcher a mes besoins:

Voici le code en entier

Sub ArrowDirection()
Dim c, p As Range, i As Long
Set p = Range("b17:l17")
i = 1
For Each c In p
    If c < 0 Then
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Rotation = 0
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.RGB = RGB(255, 0, 0)
        Sheets(11).Shapes.Range(Array("Arrow: Down " & i)).Rotation = 0
        Sheets(11).Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.RGB = RGB(255, 0, 0)
    ElseIf c > 0 Then
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Rotation = 180
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.RGB = RGB(146, 208, 80)
        Sheets(11).Shapes.Range(Array("Arrow: Down " & i)).Rotation = 180
        Sheets(11).Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.RGB = RGB(146, 208, 80)
    ElseIf c = 0 Then
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Rotation = 270
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        Sheets(11).Shapes.Range(Array("Arrow: Down " & i)).Rotation = 270
        Sheets(11).Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
    End If
    i = i + 1
Next c
End Sub

C'est un début de piste

En gros avec la nouvelle Range("B17:L17") tu fais tourner la boucle 11 fois, car il y a 11 cellules dans la plage indiquée.

Est-ce que tu a bien 11 Shapes / flèches ?

Oui, j'ai bien ajoute 11 fleches sur l'onglet voulu

Toujours le meme probleme sur la meme ligne

Sub ArrowDirection()
Dim c, p As Range, i As Long
Set p = Range("B17:L17")
i = 1
For Each c In p
    If c < 0 Then
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Rotation = 0
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.RGB = RGB(255, 0, 0)
        Sheets(11).Shapes.Range(Array("Arrow: Down " & i)).Rotation = 0
        Sheets(11).Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.RGB = RGB(255, 0, 0)
    ElseIf c > 0 Then
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Rotation = 180
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.RGB = RGB(146, 208, 80)
        Sheets(11).Shapes.Range(Array("Arrow: Down " & i)).Rotation = 180
        Sheets(11).Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.RGB = RGB(146, 208, 80)
    ElseIf c = 0 Then
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Rotation = 270
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        Sheets(11).Shapes.Range(Array("Arrow: Down " & i)).Rotation = 270
        Sheets(11).Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
    End If
    i = i + 1
Next c
End Sub

pericoo a écrit :

Oui, j'ai bien ajoute 11 fleches sur l'onglet voulu

Super, une piste en moins

Vérifie maintenant que tes Shapes aient bien les noms :

Range(Array("Arrow: Down 1"))
Range(Array("Arrow: Down 2"))
Range(Array("Arrow: Down 3"))
Range(Array("Arrow: Down 4"))
Range(Array("Arrow: Down 5"))
Range(Array("Arrow: Down 6"))
Range(Array("Arrow: Down 7"))
Range(Array("Arrow: Down 8"))
Range(Array("Arrow: Down 9"))
Range(Array("Arrow: Down 10"))
Range(Array("Arrow: Down 11"))

De 1 à 11

Si c'est pas sa, alors je donne ma langue au chat :p

Hello!

Ca marche finalement, j'ai change le nom de la feuille comme ci dessous:

Sub ArrowDirection()
Dim c, p As Range, i As Long
Set p = Range("B17:F17")
i = 1
For Each c In p
    If c < 0 Then
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Rotation = 50
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.RGB = RGB(255, 0, 0)
        Sheets("Dashboard").Shapes.Range(Array("Arrow: Down " & i)).Rotation = 90
        Sheets("Dashboard").Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.RGB = RGB(255, 0, 0)
    ElseIf c > 0 Then
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Rotation = 180
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.RGB = RGB(146, 208, 80)
        Sheets("Dashboard").Shapes.Range(Array("Arrow: Down " & i)).Rotation = 270
        Sheets("Dashboard").Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.RGB = RGB(146, 208, 80)
    ElseIf c = 0 Then
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Rotation = 270
        'ActiveSheet.Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        Sheets("Dashboard").Shapes.Range(Array("Arrow: Down " & i)).Rotation = 0
        Sheets("Dashboard").Shapes.Range(Array("Arrow: Down " & i)).Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
    End If
    i = i + 1
Next c
End Sub

Merci beaucoupp!!

Derniere chose, la macro marche bien mais les fleches ne s'actualisent pas sur mon autre onglet

Je rappelle que les donnees dans la source proviennent d'une formule et sont calcule a partir de choix effectue dans un slicer

Aurais tu une solution pour y remedier

Aaaah ~

Bien joué !

pericoo a écrit :

Derniere chose, la macro marche bien mais les fleches ne s'actualisent pas sur mon autre onglet

Je rappelle que les donnees dans la source proviennent d'une formule et sont calcule a partir de choix effectue dans un slicer

Une formule va chercher des cellules que l'on peut qualifier de "source" pour afficher un résultat.

Donc plutôt que de lancer la macro au changement de la formule, demande à lancer la macro au changement de l'une de ces "cellules sources" !

A dispo!

Bien reçu!

Quel est le moyen de lancer une macro à partir du changement de la source

Est ce qu’il faut changer le code de la macro ou il existe une manip pour le faire?

Je ne peux pas changer le code de la macro car la source contient trop de variable et de criteres que j’organise en slicer dans un dashboard

Et la fleche represente une variation en % entre deux années donc provient d’une formule

Si tu as des idées je suis preneur

pericoo a écrit :

Si tu as des idées je suis preneur

Bon bah si tu peux pas changer le code car tu a trop de donnée, et puisque l’événement Workbook_Change ne détecte pas la modification du résultat d'une formule, on va être un peu moins subtile alors :

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

Ce code est a placer dans le module ThisWorkbook

Avec ce code, quelle que soit la cellule modifié, la macro va se lancer!

Je te laisse tester et revenir vers nous :p

Hello,

Teste mais malheureusement toujours pas de changement automatique lorsque la cellule change de valeur

Re-

Point possible! Cf. Fichier Exemple ci-joint!