Zum illustrieren wie einfach die Code angepast werden kann: sechsflächer statt Commandbuttons.
Code:
Sub M_snb()
If Tabelle1.Shapes.Count = 0 Then
sn = Array(0, 5, 11, 18, 26, 35, 43, 50, 56, 61, 70)
For j = 0 To 60
y = Application.Match(j, sn, 1) - 1
With Tabelle1.Shapes.AddShape(10, 259 - IIf(y < 5, y, 8 - y) * 69 / 2 + (j - sn(y)) * 69, 30 + y * 60, 68.25, 60)
.Name = "C_" & Format(j, "00")
.Rotation = 28
End With
Next
End If
sn = Tabelle2.Cells(1).CurrentRegion
y = Abs(Int(6 * Rnd() - 0.01)) + 1
For j = 1 To UBound(sn)
If sn(j, y) = "" Then Exit For
Next
For jj = 0 To 60
With Tabelle1.Shapes("C_" & Format(jj, "00"))
.TextFrame2.TextRange.Text = sn(Abs(Int((j - 2) * Rnd() - 0.01)) + 2, y)
.Fill.ForeColor.RGB = RGB(200, 200, 200)
.TextFrame.Characters.Font.Color = RGB(0, 0, 0)
End With
Next
With Tabelle1
.[K1:K61] = "=rand()"
sp = [index(rank(T_OLE!K1:K61,T_OLE!K1:K61)-1,)]
.[K1:K61].ClearContents
End With
For j = 1 To 14
With Tabelle1.Shapes("C_" & Format(sp(j, 1), "00"))
.Fill.ForeColor.RGB = IIf(sp(j, 1) < 27, RGB(0, 0, 255), IIf(sp(j, 1) < 38, RGB(200, 100, 0), RGB(100, 100, 100)))
If sp(j, 1) < 27 Then .TextFrame.Characters.Font.Color = RGB(255, 255, 255)
End With
Next
End Sub
