Autres RESIZE EPAISSEUR FLECHE DROITE

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