Autres RESIZE EPAISSEUR FLECHE DROITE

cherraiayoub

XLDnaute Nouveau
s'il vous plaît quelqu'un parmi vous peut m'aider à trouver une solution ( macro )
comment je peux changer la taille de l'épaisseur automatiquement en fonction de la valeur d'une cellule de 1 à 30 , si la valeur de la cellule est égale 0 je veux plus la flèche apparaît, merci
 

jmfmarques

XLDnaute Accro
Lecture (que tu as zappée) à faire :
Reviens en
- saluant (la politesse est ici de mise)
- prenant la peine d'exposer de manière plus claire et précise les tenants et aboutissants de ta difficulté. (la clarté est également de mise ici)
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @cherraiayoub,

Tout ce qu'a souligné @jmfmarques est juste.

En tant que nouveau venu sur le forum, soyez le bienvenu :).

Dans le fichier joint, j'ai placé une flèche (Menu Insertion / Forme) que j'ai nommée maFleche
Dans la cellule H2, une liste de validation n'acceptant que les entiers de 0 à 30 (Menu / Données / Validations des données)

Quand la valeur de la cellule H2 est modifiée alors la flèche est redimensionnée. Elle est aussi repositionnée de telle sorte que son milieu reste à la même position sur la feuille.

Il faut indiquer au départ, les dimensions et positions initiales de la flèche '( c'est déjà fait dans le fichier - mais vous pourrez les modifiez le cas échéant). Si vous voulez (re)dimensionner la hauteur maximum et la position initiale de la flèche, il faut :
  1. lancer la macro RAZ dans le module
  2. sur la feuille, dimensionner la flèche (hauteur max) et la placer à sa position initiale
  3. sauvegarder votre classeur
Dans le module de la feuille Feuil1, il y a deux constantes pour indiquer le nom que vous avez donné à la flèche et la cellule qui contient le ratio de la hauteur à appliquer.

Code dans le module de Feuil1:
VB:
Option Explicit

Const NomShape = "mafleche"
Const CelluleRatio = "H2"

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ratio As Double, h0 As Double, top0 As Double

If Not Intersect(Target, Range(CelluleRatio)) Is Nothing Then
   With Me.Shapes(NomShape)
      ' on sauvegarde dans la propriété de la flèche "AlternativeText"
      ' les dimensions et positions initiale de la flèche
      ' si ce n'est pas déjà fait
      If .AlternativeText = "" Then
         .AlternativeText = .Height & " \" & .Width & "\" & .Top & "\" & .Left
      End If
      .Visible = Range(CelluleRatio) <> 0
      h0 = CDbl(Split(.AlternativeText, "\")(0))      'hauteur initiale
      top0 = CDbl(Split(.AlternativeText, "\")(2))    'Position verticale initiale
      .Height = h0 * Range(CelluleRatio) / 30     'Hauteur avec le ratio saisie dans la cellule CelluleRatio
      .Top = top0 + (h0 - .Height) / 2    'position verticale suite au redimensionnement

   End With
End If
End Sub

Sub RAZ()
   'RAZ des dimensions initiales
   ' 1) lancer RAZ
   ' 2) sur la feuille dimensionner la flèche
   ' 3) sauvegarder votre classeur
   Me.Shapes("mafleche").AlternativeText = ""
End Sub
 

Fichiers joints

Dernière édition:

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas