[Digressions] Shapes your booty, Fractales et consorts...

Sub Test()
dessin 290#, 15#, -280#: TSier 6, 10#, 15#, 280#
ActiveSheet.DrawingObjects.Group.Name = "TriA"
ActiveSheet.Shapes("TriA").Line.ForeColor.RGB = RGB(255, 0, 0)
[A2:E21].Interior.Color = vbBlack
End Sub

Private Sub dessin(X, Y, L)
Dim vPi, shp As Shape, f As Worksheet: Set f = ActiveSheet
vPi = WorksheetFunction.Pi()
X1 = X: X2 = X + L: X3 = X + L / 2
Y1 = 300 - Y: Y2 = 300 - (Y - L * Sin(60 * vPi / 180))
Set shp = f.Shapes.AddLine(X1, Y1, X2, Y1)
Set shp = f.Shapes.AddLine(X1, Y1, X3, Y2)
Set shp = f.Shapes.AddLine(X2, Y1, X3, Y2)
End Sub

Private Sub TSier(N, X, Y, L)
Dim vPi
vPi = WorksheetFunction.Pi()
H = L * Sin(60 * vPi / 180)
dessin X + L / 4, Y + H / 2, L / 2
If N = 0 Then Exit Sub
TSier N - 1, X, Y, L / 2
TSier N - 1, X + L / 2, Y, L / 2
TSier N - 1, X + L / 4, Y + H / 2, L / 2
End Sub

Sub Pietcolor()
Dim PIET As Range, cell As Range, colonne As Range, ligne As Range
Application.ScreenUpdating = False
Randomize
Set PIET = Range("C1:R16")
For Each cell In PIET
cell.Interior.Color = Choose(1 + (Rnd() * 6), vbBlack, vbYellow, vbWhite, vbBlue, vbRed, vbWhite)
cell.Borders.Weight = xlThick
Next
For Each colonne In PIET.Columns
colonne.ColumnWidth = Rnd() * 12
Next
For Each ligne In PIET.Rows
ligne.RowHeight = Rnd() * 60
Next
Application.ScreenUpdating = True

End Sub

Dim AngD, dAng
Sub dessin()
Application.ScreenUpdating = False
mt 350, 425, 170, AngD
[C2:J29].Interior.Color = vbBlack
End Sub
Private Function mt(xA, yA, p, a)
Dim f As Worksheet, shp As Shape: Set f = ActiveSheet
Pi = WorksheetFunction.Pi
AngD = 1.5 * Pi
dAng = 0.2 * Pi
If p >= 1# Then
xB = xA + p * Cos(a)
yB = yA + p * Sin(a)
Set shp = f.Shapes.AddLine(xA, yA, xB, yB)
mt xB, yB, p * 0.6, a + dAng
mt xB, yB, p * 0.6, a - dAng
End If
End Function

Sub Re_confinement_Amusements()
Dim rng As Range: Set rng = [A1:LH321]
rng.RowHeight = 0.75: rng.ColumnWidth = 0.08: rng.Interior.Color = vbWhite
Dim vArr(1 To 320, 1 To 320)
SC = InputBox("Saisir un chiffre entre 3 et 9", "Formes étoilées", 4)
Application.ScreenUpdating = False: ActiveSheet.DrawingObjects.Delete
For i = 1 To 320
  For j = 1 To 320
      A = i / SC
      C = Int(A * Sqr(A * j / SC) + 0.5)
        If C / 2 <> Int(C / 2) Then
        vArr(j, i) = 0
        End If
    Next j
  Next i
rng.Value = vArr
rng.FormatConditions.Add Type:=xlExpression, Formula1:="=ET(A1=0;A1<>"""")"
rng.FormatConditions(1).Interior.Color = vbBlack
rng.Copy: ActiveSheet.Pictures.Paste.Select
rng.Clear: rng.RowHeight = 15: rng.ColumnWidth = 10.71: Cells(1).Select
End Sub

Sub Dessiner_Rose_de_Maurer_en_Shapes()
Dim f As Worksheet: Set f = ActiveSheet
Dim shp As Shape
Randomize 1600
With Application
    .ScreenUpdating = False
    f.DrawingObjects.Delete: n = 6: d = 71
    For i = 0 To 360 Step 0.5
    k1 = i * d: k2 = (i + 1) * d
    r1 = 265 * Sin(.Radians(n * k1)): r2 = Sin(.Radians(n * k2)) * 265
    x1 = r1 * Cos(.Radians(k1)) + 450: y1 = r1 * Sin(.Radians(k1)) + 300
    x2 = r2 * Cos(.Radians(k2)) + 450: y2 = r2 * Sin(.Radians(k2)) + 300
    Set shp = f.Shapes.AddLine(x1, y1, x2, y2)
    shp.Line.Weight = 0.01: shp.Line.ForeColor.RGB = RGB(128, 0, 128): shp.Line.DashStyle = 11
    Next
End With
'Plus de détails ici:
'http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.97.8141&rep=rep1&type=pdf
End Sub

Sub limation_Triangulaire()
Application.ScreenUpdating = False
Sierpinski
Coloriage
End Sub
Private Sub Coloriage()
Dim r As Range: Set r = [A1:IV256]
r.RowHeight = 0.75: r.ColumnWidth = 0.08: r.Interior.Color = vbWhite
r.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=1"
r.FormatConditions(1).Interior.Color = vbBlack
r.Copy
ActiveSheet.Pictures.Paste.Select
r.Clear
r.Item(1).Select
End Sub
Private Sub Sierpinski()
For X = 0 To 255
For Y = 0 To 255
Cells(X + 1, (X And Y) + 1) = 1
Next Y
Next X
End Sub

Sub TriangleSierpinski()
Randomize 1600
    ActiveWindow.DisplayGridlines = False
    Efface
    Application.ScreenUpdating = False
    Range("A1,A2,B2").Interior.ColorIndex = Application.RandBetween(1, 56) ' ma boite de crayons
    For i = 1 To 6
        j = 2 ^ i
        With ActiveSheet.Range(Cells(1, 1), Cells(j, j))
            .Copy Cells(j + 1, 1)
            .Copy Cells(j + 1, j + 1)
        End With
    Next i
    With Cells
        .ColumnWidth = 0.35
        .RowHeight = 3.5
    End With
    [EE133].Select
    Application.ScreenUpdating = True
End Sub

Sub Triangulons_nos_Cellules()
Dim R As Range: Set R = Range("B2:BM65"): R.Clear
    With R
        .Clear: .Item(1) = 1
        .Offset(1).Resize(R.Rows.Count - 1).FormulaR1C1 = "=MOD(R[-1]C+R[-1]C[-1],2)"
        .FormatConditions.Add 1, 3, "=0": .FormatConditions(1).SetFirstPriority
        .FormatConditions(1).Interior.Color = vbBlue: .FormatConditions.Add 1, 3, "=1"
        .FormatConditions(2).SetFirstPriority: .FormatConditions(1).Interior.Color = vbYellow
        .ColumnWidth = 0.35: .RowHeight = 3.5
    End With
End Sub