### Fractale de Newton sur Excel

Script VBA

Sub drawfractal()
Dim c As Variant
n = 201
xmax = 1.2
xmin = -1.2
ymax = 1.2
ymin = -1.2

For i = 1 To n
For j = 1 To n
c = WorksheetFunction.Complex((ymax - ymin) * (j - 1) / (n - 1) + ymin, (xmax - xmin) * (i - 1) / (n - 1) + xmin)
If c = WorksheetFunction.Complex(0, 0) Then
Else
Call iterate(c, Range("A1").Offset(i - 1, j - 1))
End If
Next
Next
End Sub

Sub iterate(c As Variant, cel As Range)
k = 1
cond = True
Z0 = c
While cond = True
Z = WorksheetFunction.ImSub(Z0, WorksheetFunction.ImDiv(WorksheetFunction.ImSub(WorksheetFunction.ImPower(Z0, 3), 1), WorksheetFunction.ImProduct(3, WorksheetFunction.ImPower(Z0, 2))))
If WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(1, 0))) < 0.001 Then
cond = False
cel.Interior.Color = vbRed
ElseIf WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(Cos(2 * WorksheetFunction.Pi() / 3), Sin(2 * WorksheetFunction.Pi() / 3)))) < 0.001 Then
cond = False
cel.Interior.Color = vbGreen
ElseIf WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(Cos(4 * WorksheetFunction.Pi() / 3), Sin(4 * WorksheetFunction.Pi() / 3)))) < 0.001 Then
cond = False
cel.Interior.Color = vbBlue
End If
k = k + 1
If k > 255 Then
cond = False
cel.Interior.Color = vbBlack
End If
Z0 = Z
Debug.Print k
Wend
End Sub

Script VBA version texte

Sub drawfractal()
Dim c As Variant
n = 201
xmax = 1.2
xmin = -1.2
ymax = 1.2
ymin = -1.2

For i = 1 To n
For j = 1 To n
c = WorksheetFunction.Complex((ymax - ymin) * (j - 1) / (n - 1) + ymin, (xmax - xmin) * (i - 1) / (n - 1) + xmin)
If c = WorksheetFunction.Complex(0, 0) Then
Else
Call iterate(c, Range("A1").Offset(i - 1, j - 1))
End If
Next
Next
End Sub

Sub iterate(c As Variant, cel As Range)
k = 1
cond = True
Z0 = c
While cond = True
Z = WorksheetFunction.ImSub(Z0, WorksheetFunction.ImDiv(WorksheetFunction.ImSub(WorksheetFunction.ImPower(Z0, 3), 1), WorksheetFunction.ImProduct(3, WorksheetFunction.ImPower(Z0, 2))))
If WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(1, 0))) < 0.001 Then
cond = False
cel = 0
ElseIf WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(Cos(2 * WorksheetFunction.Pi() / 3), Sin(2 * WorksheetFunction.Pi() / 3)))) < 0.001 Then
cond = False
cel = 1
ElseIf WorksheetFunction.ImAbs(WorksheetFunction.ImSub(Z, WorksheetFunction.Complex(Cos(4 * WorksheetFunction.Pi() / 3), Sin(4 * WorksheetFunction.Pi() / 3)))) < 0.001 Then
cond = False
cel = 2
End If
k = k + 1
If k > 255 Then
cond = False
cel.Interior.Color = vbBlack
End If
Z0 = Z
Debug.Print k
Wend
End Sub