Discussion :

[awa123]

Bonjour ,

je voudrais savoir comment garder un message sur une image même après execution du programme.

cf pièce jointe pour l'illustration de ce que je veux dans le classeur map.

Merci beaucoup!!

[mercatog]

D'abord il faudra supprimer (manuellement toutes les bulles existantes)
Ensuite Dissocier toutes les shapes et enfin essaies les codes

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
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Sub MatriceDeBulles()
Const Couleur As Long = 9852
Dim Ech As Double, L As Double, T As Double, W As Double
Dim c As Range, Plage As Range
Dim i As Integer
 
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Data")
    Set Plage = .Range("E3:E" & .Range("E" & Rows.Count).End(xlUp).Row)
End With
'-----Echelle
Ech = 50 / Application.Max(Plage)
With ThisWorkbook.Worksheets("MAP")
    SupShape .Name
    For Each c In Plage
        W = Ech * c.Value                        'Diametre de la bulle
        With .Shapes(c.Offset(0, -3).Value)
            L = .Left + c.Offset(0, -2).Value + .Width / 2 - W / 2
            T = .Top + c.Offset(0, -1).Value + .Height / 2 - W / 2
        End With
        '-----Ajout de la bulle
        i = i + 1
        With ActiveSheet.Shapes.AddShape(msoShapeOval, L, T, W, W)
            .Name = "BULLE" & i
            .Fill.ForeColor.RGB = Couleur
            .Line.ForeColor.RGB = Couleur
        End With
    Next c
    Set Plage = Nothing
    Montrer .Name
End With
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
        If Left(Shp.Name, 5) = "BULLE" Then Shp.Delete
    End If
Next Shp
End Sub
 
'---Mettre les textes et les symboles des villes en premier plan
Private Sub Montrer(ByVal SheetName As String)
Dim Shp As Shape
 
For Each Shp In Worksheets(SheetName).Shapes
    Select Case True
        Case Shp.Type = 1 And InStr(Shp.Name, "BULLE") = 0: Shp.ZOrder msoBringToFront
        Case Shp.Type = 17: Shp.ZOrder msoBringToFront
    End Select
Next Shp
End Sub