Bulles se positionnent sur une image comme on veut (VBA)

awa123

XLDnaute Occasionnel
Bonjour ,

Je cherche le code qui permet, à partir d'une feuille excel de rentrer les coordonnées des bulles (qui sont toujours proportionnelles entre elles) sur une même image et ainsi fixer le centre de chaque bulles.

cf. l'illustration en pièce jointe : sur la feuille 2, on rentre les valeurs et sur la feuille 1, on voit le resultat.

le code que j'ai déjà pour centrer les bulles générés sont :

Option Explicit
Sub MatriceDeBulles()

'-----Constantes
Const Destination As String = "D10" 'Cellule de destination de la matrice
Const Couleur As Long = "670343" 'Couleur des bulles
Const Larg As Byte = 10 'Largeur des cellules de la matrice

'-----Variables
Dim Fe As Worksheet
Dim Ech As Double, L As Double, T As Double, W As Double, Largeur As Double
Dim c As Range, v As Range, Plage As Range, Dest As Range
Dim dL As Integer, dC As Integer
Dim Shp As Shape
Set Fe = Worksheets("Feuil1")
Application.ScreenUpdating = False
With Fe
For Each Shp In .Shapes
If Shp.Type = 1 Then Shp.Delete
Next Shp
Set Plage = .Range("B2:B4")
End With

'-----Echelle
Ech = 50 / Application.Max(Plage)
For Each c In Plage
W = Ech * c.Value 'Diametre de la bulle
With ActiveSheet.Shapes(c.Offset(0, -1).Value)
L = .Left + .Width / 2 - W / 2
T = .Top + .Height / 2 - W / 2
End With

'-----Ajout de la bulle
With Fe.Shapes.AddShape(msoShapeOval, L, T, W, W)
.Fill.ForeColor.RGB = Couleur
.Line.ForeColor.RGB = Couleur
End With
Next c
Set Plage = Nothing
End Sub



'-----Suppression des bulles
Private Sub SupShape(ByVal SheetName As String)
Dim Shp As Shape

For Each Shp In Worksheets(SheetName).Shapes
If Shp.Type = 1 Then Shp.Delete
Next Shp
End Sub

Je ne sais pas si c'est possible que l'on mette dans le code:

L = .Left + la valeur qu'on rentre en "C3"
T = .Top + la valeur qu'on rentre en "D3"

Ainsi, on jouant sur les valeurs en "C3" et "D3" on trouvera l'emplacement correspondant.

Merci beaucoup!!
 

Pièces jointes

  • Bulles generées2..xlsx
    22.5 KB · Affichages: 31

Discussions similaires

Réponses
0
Affichages
153
Réponses
2
Affichages
421

Statistiques des forums

Discussions
312 228
Messages
2 086 421
Membres
103 205
dernier inscrit
zch