Discussion :

[zinebfilali]

bonjour, dans le fichier adjoint j'ai créer un tableau contenant 2 colonne, A et B, j'ai dessiner un petit flèche qui doit avoir liaison avec le numéro 1.. je veux que la flèche s’étend quand je change 1 par 2, et s’étend plus quand je change 2 par 3, et ainsi de suite jusqu’à un longueur précis.
il me suffit un petit code VBA qui relit les deux colonnes et qui pour régle la longueur d'une flèche déjà créer...
cordialement

[Thautheme]

Bonjour Zinebfilali, bonjour le forum,

Je ne sais pas faire ce que tu demandes aussi je te propose une alternative avec le code événementiel ci-dessous placé dans le composant Feuil3 (Feuil3) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
If Target.Column = 1 And Target.Row > 1 Then 'condition : si le changement a lieur dans la colonne 1 et dans une ligne supérieure à 1
    Cells(Target.Row, 2).Resize(1, 10).Interior.ColorIndex = xlNone 'efface la couleur des 10 cellules
    If Target.Value > 0 Then Cells(Target.Row, 2).Resize(1, Target.Value).Interior.ColorIndex = 3 'colore de rouges des X cellules de la ligne (X=le nombre tapé dans la colonne 1)
End If 'fin de la condition
End Sub

J'ai modifié ton tableau. Regarde l'onglet Feuil3. Tape une note dans la colonne A.

[Philippe Tulliez]

Bonjour,
N'ouvrant pas les classeurs joints je ne peux que deviner ce que tu attends et avec qu'elle outils tu as construit la flèche
J'ai supposé que la flèche a été créée à l'aide de l'outil Dessin (Commande Formes du groupe Illustration de l'onglet [Insertion] soit pour le VBA, un objet Shape
Un objet Shape à plusieurs propiétés dont Height qui gère la hauteur

Voici un exemple d'une fonction nommée Arrow à laquelle on passe le nom de l'argument et sa hauteur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Function Arrow(oShape As Shape, Height As Double)
  oShape.Height = Height
End Function

Exemple de la façon dont on peut l'invoquer. Pour l'exemple la flèche se nomme Arrow

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub TestArrow()
 Arrow shtFolderList.Shapes("Arrow_2"), 30.2
End Sub

Tu peux bien entendu ajouter des propriétés optionnelles ou pas à cette fonction pour l'exploiter au mieux.

Si tu veux que la hauteur réagisse en fonction d'un nombre comme 1, 2, 3, etc. tu peux varier les plaisirs

Exemple de la fonction modifiée. Ici la hauteur sera augmentée par la valeur de la constante HeightUnit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Function Arrow(oShape As Shape, ValueUnit As Integer)
  Const HeighUnit As Double = 12.2
  oShape.Height = HeighUnit * ValueUnit
End Function

Comment l'invoquer ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub TestArrow()
 Arrow shtFolderList.Shapes("Arrow_2"), 5
End Sub

[EDIT]
Et pour te permettre d'en faire plus, voici la fonction étoffée d'autres arguments qui sont tous optionnels (à l'exception de l'objet Shape) et ont une valeur par défaut

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Function Arrow(oShape As Shape, _
               Optional Top As Double = 12.1, _
               Optional Width As Double = 20, _
               Optional ValueUnit As Integer = 1)
  Const HeighUnit As Double = 12.2
  With oShape
  .Height = HeighUnit * ValueUnit
  .Width = Width
  .Top = Top
  End With
End Function

Exemple pour l'invoquer. Code que tu peux placer dans la procédure événementielle Worksheet_Change comme te l'a suggéré Thautheme que je salue au passage

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub TestArrow()
 Arrow shtFolderList.Shapes("Arrow_2"), ValueUnit:=5
End Sub

[BENNASR]

c'est une grande audace pour moi de répondre après une intervention les grands Messieurs du site mais comme débutant qui bricole toujours je propose :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub Worksheet_Change(ByVal Target As Range)
Dim F1 As Worksheet
Set F1 = Sheets("Feuil1")
 
F1.Shapes(1).Top = [B2].Top
F1.Shapes(1).Left = [B2].Left
F1.Shapes(1).Width = F1.Range("A2").Value * 10
 
F1.Shapes(2).Top = [B3].Top
F1.Shapes(2).Left = [B3].Left
F1.Shapes(2).Width = F1.Range("A3").Value * 10
 
F1.Shapes(3).Top = [B4].Top
F1.Shapes(3).Left = [B4].Left
F1.Shapes(3).Width = F1.Range("A4").Value * 10
 
F1.Shapes(4).Top = [B5].Top
F1.Shapes(4).Left = [B5].Left
F1.Shapes(4).Width = F1.Range("A5").Value * 10
 
End Sub

[patricktoulon]

bonjour BENNARS
donc avec ton model tu remet tout tes shapes a jour quand tu change une seul cellule en A1(c'est pas top)

le plus simple est de nommer tes fleche de facon a ce ca coincide avec la cellule en col A

et tu fait qu'un seul changement
et pour peu qu'il manque une shape et ben c'est l'erreur qu'il faut gérer surtout si on parle de tableau en constante évolution

les shapes sont nommées "cellA1",cellA2,cellA3" etc......
l'evenement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim fleche As Object
    If Target.Column = 1 Then
        On Error Resume Next
        Set fleche = ActiveSheet.Shapes("cell" & Target.Address(0, 0))
        If Error.Number = 0 Then
            With ActiveSheet.Shapes("cell" & Target.Address(0, 0))
                .Top = Target.Top
                .Left = Target.Offset(, 1).Left
                .Width = Target.Value * 10
            End With
        Err.Clear
        End If
    End If
End Sub