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
|
Option Explicit
Sub init()
'
Dim i As Integer
'
Sheets.Add: Columns("A:L").ColumnWidth = 5
Range("A1:L1").Value = 9
Range("A1:L1").Font.Size = 9
Range("A1:L1").HorizontalAlignment = xlCenter
'
For i = 1 To 7
'
With ActiveSheet.Shapes.AddShape(msoShapeOval, (i * 32) + 32, 20, 20, 20)
'
.Name = "shape_" & (i + 2)
.ShapeStyle = msoShapeStylePreset1
.Line.Weight = 0
.OnAction = "clic"
.Shadow.Type = msoShadow21
'
If (i < 4) Then Cells(1, (i + 2)).Value = 1: .Fill.ForeColor.RGB = RGB(102, 255, 51)
If (i = 4) Then Cells(1, (i + 2)).Value = 0
If (i > 4) Then Cells(1, (i + 2)).Value = 2: .Fill.ForeColor.RGB = RGB(255, 255, 102)
'
End With
'
Next i
'
End Sub
Sub clic()
'
Dim i As Integer
'
i = Mid(Application.Caller, 7, 1)
'
MsgBox i & " : " & Cells(1, i).Value ' test
'
End Sub |
Partager