Discussion :

[zipbox]

Bonjour,

Sur une feuille d’un classeur Excel 2010, je positionne des petits rectangles avec l’instruction « AddShape »

Pour chaque petit rectangle : je donne un nom « .Name » et j’affecte une macro « .OnAction »

Cependant : j’ai une macro par rectangle.

Si j’ai 100 rectangles sur la feuille, je dois prévoir 100 macros.

Existe-t-il une méthode, pour ne prévoir qu’une macro unique, qui me donnerait le nom de la forme qui a réceptionné le clic ?

Voici le bout de code, j’aimerais bien éviter les macros « clic_01 » etc.

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
 
Option Explicit
 
Sub shapes_init()
  '
  Dim i As Integer, j As Integer, n As Integer
  '
  n = 0
  '
  For j = 1 To 3
    For i = 1 To 3
      '
      n = n + 1
      '
      ActiveSheet.Shapes.AddShape(msoShapeRectangle, (i * 60), (j * 50), 60 - 10, 50 - 10).Select
      Selection.ShapeRange.Name = "shape_" & Format(n, "00")
      Selection.ShapeRange.ShapeStyle = msoShapeStylePreset21
      Selection.OnAction = "clic_" & Format(n, "00")
      '
    Next i
  Next j
  '
  Cells(1, 1).Select
  '
  MsgBox " init : fin "
  '
End Sub
 
Sub clic_01()
  Call shape_clic(1)
End Sub
 
Sub clic_02()
  Call shape_clic(2)
End Sub
 
Sub clic_03()
  Call shape_clic(3)
End Sub
 
Sub clic_04()
  Call shape_clic(4)
End Sub
 
Sub clic_05()
  Call shape_clic(5)
End Sub
 
Sub clic_06()
  Call shape_clic(6)
End Sub
 
Sub clic_07()
  Call shape_clic(7)
End Sub
 
Sub clic_08()
  Call shape_clic(8)
End Sub
 
Sub clic_09()
  Call shape_clic(9)
End Sub
 
Sub shape_clic(n)
  '
  If (ActiveSheet.Shapes(n).ShapeStyle = msoShapeStylePreset21) Then
    ActiveSheet.Shapes(n).ShapeStyle = msoShapeStylePreset20
  Else
    ActiveSheet.Shapes(n).ShapeStyle = msoShapeStylePreset21
  End If
  '
End Sub

Merci.

[Menhir]

Cependant : j’ai une macro par rectangle.

Ca n'a rien d'obligatoire.
Tu peux utiliser la propriété Caller pour savoir quelle forme à appelé.
https://msdn.microsoft.com/fr-fr/VBA...property-excel

Essaye de relier la macro suivant à une de tes formes et regarde ce qui s'affiche dans la fenêtre d'exécution :

Code :

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

1
2
3
Sub test()
Debug.Print Application.Caller
End Sub

[zipbox]

Super merci . . .

C'est top . . .

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
 
Option Explicit
 
Sub shapes_init()
  '
  Dim i As Integer, j As Integer, n As Integer
  '
  n = 0
  '
  For j = 1 To 10
    For i = 1 To 10
      '
      n = n + 1
      '
      ActiveSheet.Shapes.AddShape(msoShapeRectangle, (i * 60), (j * 50), 60 - 10, 50 - 10).Select
      Selection.ShapeRange.Name = "shape_" & Format(n, "00")
      Selection.ShapeRange.ShapeStyle = msoShapeStylePreset21
      Selection.OnAction = "shape_clic"
      '
    Next i
  Next j
  '
  Cells(1, 1).Select
  '
  MsgBox " init : fin "
  '
End Sub
 
Sub shape_clic()
  '
  Dim NomShape As String
  '
  NomShape = Application.Caller
  '
  ' MsgBox NomShape
  '
  If (ActiveSheet.Shapes(NomShape).ShapeStyle = msoShapeStylePreset21) Then
    ActiveSheet.Shapes(NomShape).ShapeStyle = msoShapeStylePreset20
  Else
    ActiveSheet.Shapes(NomShape).ShapeStyle = msoShapeStylePreset21
  End If
  '
End Sub

[zipbox]

Encore merci Menhir,

Voici un bout de code plus complet, il fonctionne dans un classeur avec 3 feuilles

feuille 1: 45 petits rectangles, qui compose un mini Rubik's Cube
feuille 2: 45 Noms
feuille 3: 45 Couleurs

45 clics pour une seule macro : Application.Caller

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
 
Option Explicit
 
Sub init()
  '
  Dim n As Integer
  Dim i As Integer, j As Integer, k As Integer
  Dim a As Integer, b As Integer, c As Integer
  '
  n = 0
  '
  For k = 1 To 5
    '
    If k = 1 Then a = 2: b = 1: c = 21
    If k = 2 Then a = 3: b = 2: c = 18
    If k = 3 Then a = 2: b = 3: c = 20
    If k = 4 Then a = 1: b = 2: c = 17
    If k = 5 Then a = 2: b = 2: c = 19
    '
    For j = (b * 3) - 1 To (b * 3) + 1
      For i = (a * 3) - 1 To (a * 3) + 1
        '
        n = n + 1
        '
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, (i * 60) - 60, (j * 50) - 50, 60 - 10, 50 - 10).Select
        Selection.ShapeRange.Name = "shape_" & Format(n, "00")
        Selection.ShapeRange.ShapeStyle = c
        Selection.OnAction = "shape_clic"
        '
        Sheets(2).Cells(j, i).Value = n
        Sheets(3).Cells(j, i).Value = c
        '
      Next i
    Next j
    '
  Next k
  '
  Cells(1, 1).Select
  '
End Sub
 
Sub shape_clic()
  '
  Dim NomShape As String
  Dim i As Integer, j As Integer
  Dim r1 As String, r2 As String, r3 As String, r4 As String
  '
  Select Case Right(Application.Caller, 2)
  Case 1, 4, 7
    r1 = "E1:E9": r2 = "E2:E10": r3 = "E10": r4 = "E1"
  Case 2, 5, 8
    r1 = "F1:F9": r2 = "F2:F10": r3 = "F10": r4 = "F1"
  Case 3, 6, 9
    r1 = "G1:G9": r2 = "G2:G10": r3 = "G10": r4 = "G1"
  Case 10, 11, 12
    r1 = "C5:K5": r2 = "B5:J5": r3 = "B5": r4 = "K5"
  Case 13, 14, 15
    r1 = "C6:K6": r2 = "B6:J6": r3 = "B6": r4 = "K6"
  Case 16, 17, 18
    r1 = "C7:K7": r2 = "B7:J7": r3 = "B7": r4 = "K7"
  Case 21, 24, 27
    r1 = "G3:G11": r2 = "G2:G10": r3 = "G2": r4 = "G11"
  Case 20, 23, 26
    r1 = "F3:F11": r2 = "F2:F10": r3 = "F2": r4 = "F11"
  Case 19, 22, 25
    r1 = "E3:E11": r2 = "E2:E10": r3 = "E2": r4 = "E11"
  Case 34, 35, 36
    r1 = "A7:i7": r2 = "B7:J7": r3 = "J7": r4 = "A7"
  Case 31, 32, 33
    r1 = "A6:i6": r2 = "B6:J6": r3 = "J6": r4 = "A6"
  Case 28, 29, 30
    r1 = "A5:i5": r2 = "B5:J5": r3 = "J5": r4 = "A5"
  Case Else
    r1 = "": r2 = "": r3 = "": r4 = ""
  End Select
  '
  If (r1 <> "") Then
    '
    Sheets(3).Range(r1).Value = Sheets(3).Range(r2).Value
    Sheets(3).Range(r3).Value = Sheets(3).Range(r4).Value
    Sheets(3).Range(r4).Value = ""
    '
    For i = 1 To 9
      For j = 1 To 9
        '
        If (Sheets(2).Cells((i + 1), (j + 1)).Value > 0) Then
          '
          NomShape = "Shape_" & Format(Sheets(2).Cells((i + 1), (j + 1)).Value, "00")
          ActiveSheet.Shapes(NomShape).ShapeStyle = Sheets(3).Cells((i + 1), (j + 1)).Value
          '
        End If
        '
      Next j
    Next i
    '
  End If
  '
End Sub