Checkbox qui générent plusieurs objets

Bonjour,

j'ai un fichier qui contient 2 feuilles :

Une feuille 'donnee' qui contient le nom des différentes villes associés à une date (colonne F).

Ainsi dans la feuille 'carte' j'ai mis une carte de la france avec les checkbox nommé '2012' et 'present' qui consiste à générer un cercle représentant la ville en question. ( la colonne 'E' represente la taille du cercle.)

le Probleme est que je ne comprends pas pourquoi ça me génére plusieurs cercles superposés lorsque je coche une case???

Bonjour

Même demande qu'ici

https://forum.excel-pratique.com/excel/cases-a-cocher-t35000.html#p197923

Bonjour Banzai64,

voici mon fichier au format xls. (cf piece jointe).

et voici le code qui est dans le module :

Sub essai()
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
Dim Ctrl As MSForms.CheckBox
Dim Ch As OLEObject
Dim i As Integer, j As String
Dim an As String, derligne As Integer
Sheets("carte").Select
  Set Fe = Worksheets("donnee")
  Application.ScreenUpdating = False
  For Each Shp In ActiveSheet.Shapes
    If Shp.Type = 1 Then Shp.Delete
  Next Shp
  Set Plage = Fe.Range("E3:E" & Fe.Range("E" & Rows.Count).End(xlUp).Row)

  '-----Echelle
' Stop
For Each Ch In Worksheets("carte").OLEObjects
    If Ch.Name Like "CheckBox*" Then
        If Ch.Object.Value = False Then GoTo suite
      If Ch.Object.Value = True Then
            an = Ch.Object.Caption
      End If
    End If
 derligne = Sheets("donnee").Range("A65536").End(xlUp).Row

  For i = 3 To derligne
  j = Sheets("donnee").Range("F" & i)
 If Sheets("donnee").Range("F" & i) <> an Then GoTo suite
  Set Plage = Fe.Range("E" & i & ":E" & 6)
  Ech = 50 / Application.Max(Plage)
  For Each c In Plage
    W = Ech * Sheets("donnee").Range("E" & i).Value 'c.Value 'Diametre de la bulle
    With ActiveSheet.Shapes(Sheets("donnee").Range("B" & i).Value)
      L = .Left + Sheets("donnee").Range("C" & i).Value + .Width / 2 - W / 2
      T = .Top + Sheets("donnee").Range("D" & i).Value + .Height / 2 - W / 2
'      L = .Left + Sheets("Feuil2").Range("C3") + .Width / 2 - W / 2
'      T = .Top + Sheets("Feuil2").Range("D3") + .Height / 2 - W / 2
    End With

    '-----Ajout de la bulle
    With ActiveSheet.Shapes.AddShape(msoShapeOval, L, T, W, W)
      .Fill.ForeColor.RGB = RGB(0, 32, 96)
      .Line.ForeColor.RGB = RGB(0, 32, 96)
    End With
  Next c
suite:
  Next i
  Next Ch
  Set Plage = Nothing
  'Fe.Select
End Sub

Bonsoir

Pour simplifier le problème n'utilise pas les listes

C'est assez compliqué (à mon avis) de s'en servir

Transformes ta liste en plage et tu verras que cela ira mieux à programmer

Un essai avec ta liste

merci!!