Triangle de Sierpinski sur Excel

Utiliser une feuille Excel pour générer le triangle de Sierpinski


Vidéo sur @SparksMaths



Code VBA

Sub draw()
Dim cel1 As Range
Dim cel2 As Range
Dim cel3 As Range
Dim cel As Range

Dim i As Integer
Dim j As Integer
Dim l As Single
Dim Phi As Single
Set cel1 = Range("A1")
Set cel2 = Range("A1").Offset(0, 200)
Set cel3 = Range("A1").Offset(100, 100)
cel1.Interior.Color = vbRed
cel2.Interior.Color = vbBlue
cel3.Interior.Color = vbGreen
Set cel = cel1.Offset(25, 100)
cel.Interior.Color = vbBlack
For i = 1 To 10000
    j = Int((3 - 1 + 1) * Rnd() + 1)
    Select Case j
        Case 1
            l = Sqr((cel1.Column - cel.Column) ^ 2 + (cel1.Row - cel.Row) ^ 2)
            Phi = WorksheetFunction.Atan2((cel1.Column - cel.Column), (cel1.Row - cel.Row))
        Case 2
            l = Sqr((cel2.Column - cel.Column) ^ 2 + (cel2.Row - cel.Row) ^ 2)
            Phi = WorksheetFunction.Atan2((cel2.Column - cel.Column), (cel2.Row - cel.Row))
        Case 3
            l = Sqr((cel3.Column - cel.Column) ^ 2 + (cel3.Row - cel.Row) ^ 2)
            Phi = WorksheetFunction.Atan2((cel3.Column - cel.Column), (cel3.Row - cel.Row))
    End Select
    Set cel = Cells(cel.Row + Fix(0.5 * l * Sin(Phi)), cel.Column + Fix(0.5 * l * Cos(Phi)))
    Select Case j
        Case 1
            cel.Interior.Color = vbRed
        Case 2
            cel.Interior.Color = vbBlue
        Case 3
            cel.Interior.Color = vbGreen
    End Select
Next
End Sub

Commentaires

Posts les plus consultés de ce blog

Nom des services Windows en Français et en Anglais

How to determine eigenvalues and eignevectors of a matrix in Excel

Analyse de Fourrier sur Excel