Gerer un fleche selon une condition
zinebfilali
-
zinebfilali -
zinebfilali -
Bonjour, dans un fichier excel, j'ai dessiner un tableau de 2 colonnes, le 1er colonne contient des nombres, le 2eme ou s'existe le problème
je veut que selon le nombre déclarer dans la colonne 1, le flèche se varie
par exemple:
si j'entre le numero 2, la flèche se dessine d'une petite longueur
si j'entre le numero3, la flèche va s’étend un peu...
et ainsi de suite
merci de m'aider et m'indique comment je peu varier la longueur par un code VBA
NB: ce n'ai pas important pour moi quelle manière la flèche va se dessiner
cordialement
je veut que selon le nombre déclarer dans la colonne 1, le flèche se varie
par exemple:
si j'entre le numero 2, la flèche se dessine d'une petite longueur
si j'entre le numero3, la flèche va s’étend un peu...
et ainsi de suite
merci de m'aider et m'indique comment je peu varier la longueur par un code VBA
NB: ce n'ai pas important pour moi quelle manière la flèche va se dessiner
cordialement
4 réponses
-
Bonjour,
voir dans ce site: AddLine(débutX,débutY,finX,finY)
http://boisgontierjacques.free.fr/pages_site/lesimages.htm#Ecriture
voir le nom des shapes:
https://www.developpez.net/forums/d1013450/logiciels/microsoft-office/excel/macros-vba-excel/liste-shape/
Ce qui donne a adapter:
ActiveSheet.Shapes.AddShape(msoShapeNotchedRightArrow, 10, 10, 100, 10).Name = "xxx"
et pour effacer:
Sub EffaceShapesSaufBoutons() Dim i As Variant For Each i In ActiveSheet.Shapes If i.Type <> 8 And i.Type <> 12 Then ActiveSheet.Shapes(i.Name).Delete 'Range("A1") = i.Name 'nom de la shape End If Next i End Sub
avec cela tu as de quoi t'amuser
-
-
merci bcp le code ActiveSheet.Shapes.AddShape(msoShapeNotchedRightArrow, 10, 10, 100, 10).Name = "xxx"
ça fonctionne...
je vais essayer pour modifier le longueur selon condition-
Voici un exemple avec Target
https://forum.excel-pratique.com/viewtopic.php?t=1314
Faire Alt F11 pour accéder à l'éditeur. Coller ce code dans le module de la feuille active.
C'est réglé pour mettre les infos dans A2 à adapter:
Option Explicit 'https://forum.excel-pratique.com/viewtopic.php?t=1314 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim longueur As Integer If Not Application.Intersect(Target, Range("A2")) Is Nothing Then If Target.Value = "" Then Exit Sub EffaceShapesSaufBoutons longueur = Target.Value * 10 ActiveSheet.Shapes.AddShape(msoShapeNotchedRightArrow, 60, 20, longueur, 10).Name = "xxx" End If End Sub Sub EffaceShapesSaufBoutons() Dim i As Variant For Each i In ActiveSheet.Shapes If i.Type <> 8 And i.Type <> 12 Then ActiveSheet.Shapes(i.Name).Delete 'Range("A1") = i.Name End If Next i End Sub
Voilà
@+ Le Pivert
-
-
j'ai essayer avec pas mal de combinaison mais il ne se fonctionne pas par ce dernier code. il ne dessine pas la flèche.
