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

Modeste geedee · 6 Avril 2020

Bonsour®
On pourra cependant diviser ce nombre par 4
(matrice carrée, symétries selon médianes et diagonales)

Staple1600 · 7 Avril 2020

Bonsoir Modeste geedee

Si on peut le faire, alors faisons le

Mais je ne suis pas le plus matheux d'entre vous (hélas) pour ce faire.
Ce genre de choses est trop compliquée pour moi.

Geometry of the 4x4 Square

Geometry of the 4x4 square

finitegeometry.org

(même en français)

Staple1600 · 8 Avril 2020

Re

Je me rapproche

Polyomino — Wikipédia

fr.wikipedia.org

Il y a un matheux* (confiné ou pas

) parmi vous pour éclairer ma lanterne?

*: Bien sur le matheux qui serait une matheuse sera la bienvenue.

Staple1600 · 28 Avril 2020

Bonsoir le fil

L'abus de confinement nuit gravement à mon Excel

Je vous laisse juge de la chose
(Si vous avez d'autres jolis points dans l'Array, n'hésitez point

)

VB:

Sub De_L_Amour_De_L_Art_Ou_Du_Cochon()
Dim shp As Shape, i&, j&, k&, X&
ActiveSheet.DrawingObjects.Delete
Dim points(1 To 10, 1 To 2) As Single
Randomize 1600
X = Application.RandBetween(5, 22)
For k = 1 To X
For i = 1 To UBound(points, 1)
For j = 1 To UBound(points, 2)
points(i, j) = Application.RandBetween(17, 467)
Next j
Next i
Application.ScreenUpdating = False
Set shp = ActiveSheet.Shapes.AddCurve(SafeArrayOfPoints:=points)
shp.Line.ForeColor.RGB = RGB(255 * Rnd, 166 * Rnd, 255 * Rnd)
shp.SoftEdge.Type = msoSoftEdgeType6
shp.Fill.ForeColor.RGB = RGB(255 * Rnd, 255 * Rnd, 122 * Rnd)
shp.ThreeD.PresetMaterial = Application.RandBetween(1, 15)
Next
ActiveSheet.DrawingObjects.Group.Name = "OCBO"
Set shp = ActiveSheet.Shapes("OCBO")
shp.Glow.Transparency = 0.96
shp.Glow.Radius = 2
[A1:I33].Interior.Color = RGB(65 * Rnd, 255 * Rnd, 255 * Rnd)
shp.BackgroundStyle = Application.RandBetween(1, 11)
shp.IncrementLeft 23.25
shp.IncrementTop 9.75
Set shp = Nothing
Application.ScreenUpdating = True
End Sub

mapomme · 28 Avril 2020

Personnellement, je préfère ceux qui sont le moins chargés les plus aérés.

Staple1600 · 28 Avril 2020

Bonsoir mapomme

Justement, tu n'aurais point quelques formules mathématiques pour remplir points avec des points "remarquables"?
Ou de jolis exemples avec Shapes.AddPolyline

Staple1600 · 29 Avril 2020

Re

On doit pouvoir des choses plus mathématiques, non?

VB:

Sub Tu_me_feras_100_lignes_sur_papier_à_petits_KRO()
Dim s As Shape, shp As Shape, i&, a, pts() As Single
a = Array(1, 2, 3, 4, 5, 7)
ReDim pts(200, 1): Randomize 1600
ActiveSheet.DrawingObjects.Delete
For i = 30 To 199
pts(i, 0) = Application.RandBetween(30, 888)
pts(i, 1) = Application.RandBetween(30, 555)
Next
Set s = ActiveSheet.Shapes.AddPolyline(pts)
s.Fill.TwoColorGradient a(Application.RandBetween(1, 5)), 1
s.Fill.BackColor.RGB = RGB(255 * Rnd, 255 * Rnd, 255 * Rnd)
s.Fill.ForeColor.RGB = RGB(255 * Rnd, 255 * Rnd, 255 * Rnd)
s.Line.ForeColor.RGB = RGB(255 * Rnd, 255 * Rnd, 255 * Rnd)
s.Fill.GradientStops.Insert RGB(255, 48, 111), 0.37
s.Fill.GradientStops.Insert RGB(200, 96, 255), 0.7
s.Glow.Transparency = 0.96: s.Glow.Radius = 3
[A1:O45].Interior.Color = RGB(127 * Rnd, 0, 77 * Rnd)
End Sub

mapomme · 29 Avril 2020

Bonjour @Staple1600 et bonne journée...

Staple1600 à dit:
On doit pouvoir des choses plus mathématiques, non?

J'accroche moins

. Allez! Au télétravail.

Staple1600 · 29 Avril 2020

Bonjour mapomme

Nous sommes dans le digressif.
Il n'est pas nécéssaire d'accrocher, non ?
Mais tu as raison, ma journée de télétravail commence à 9ALT+0160heures

Staple1600 · 30 Avril 2020

Bonsoir le fil

Question: Aurais-je pondu ce VBA sans le confinement?
Sans doute pas.
Et cela aurait été dommage, non ?

Car c'est joli, mignon, tout plein

Et ça égayera votre Excel le soir à la veillée

VB:

Sub testAA()
Dim Px, s As Shape: Randomize 1600
ActiveSheet.DrawingObjects.Delete
Px = Application.RandBetween(3, 7): [A1:K40].Interior.Color = vbBlack
Staple_Gribouille 0.67654, Px, msoThemeColorAccent4
Set s = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
s.Line.DashStyle = msoLineSysDot
s.Glow.Transparency = 0.89: s.Glow.Radius = 3
s.IncrementLeft 75: s.IncrementTop 25: s.Flip 1
End Sub
Sub testBB()
Dim Px, s As Shape: Randomize 1600
ActiveSheet.DrawingObjects.Delete
Px = Application.RandBetween(3, 7): [A1:K40].Interior.Color = vbBlack
Staple_Gribouille 0.67654, Px, msoThemeColorDark2
Set s = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
s.Line.DashStyle = msoLineSysDot
s.Glow.Transparency = 0.89: s.Glow.Radius = 3
s.IncrementLeft 75: s.IncrementTop 25: s.Flip 1
End Sub
Sub testCC()
Dim Px, s As Shape: Randomize 1600
ActiveSheet.DrawingObjects.Delete
Px = Application.RandBetween(3, 7): [A1:K40].Interior.Color = vbBlack
Staple_Gribouille 1.33, Px, msoThemeColorLight1, 125
Set s = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
s.Line.DashStyle = msoLineSysDashDot
s.Line.ForeColor.RGB = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
s.IncrementLeft 75: s.IncrementTop 25: s.Flip 0
End Sub

Private Sub Staple_Gribouille(PaK, ItO, Them As MsoThemeColorIndex, Optional s As Integer = 2 ^ 7)
Dim b, c, d, g, n%, i%, r As Double, shp As Shape, p() As Single
n = s: c = (Sqr(ItO) + 1) / 2: ReDim p(n, 1)
For i = 0 To n Step PaK
r = i ^ c / (n / 5): g = 1.75 * 3.141592656 * c * i
p(i, 0) = r + Cos(g) * 2 * i: p(i, 1) = r - Sin(g) * 2 * i
Next
Set shp = ActiveSheet.Shapes.AddPolyline(p)
shp.Fill.ForeColor.ObjectThemeColor = Them
End Sub

Staple1600 · 3 Mai 2020

Bonsoir le fil

Dans la série: Trop de confinement dénature mon Excel

Mais au moins, si c'est futile, c'est joli, non ?

VB:

Sub Gribouille_1()
ActiveSheet.DrawingObjects.Delete
Corona_Yeah_But_No_Virus 5, 8, msoLineLongDashDotDot
End Sub
Sub Gribouille_2()
ActiveSheet.DrawingObjects.Delete
Corona_Yeah_But_No_Virus msoShapeRegularPentagon, 6
End Sub
Sub Gribouille_3()
ActiveSheet.DrawingObjects.Delete
Corona_Yeah_But_No_Virus msoShapeRound2SameRectangle, 10, msoLineSquareDot
End Sub
Sub Gribouille_4()
ActiveSheet.DrawingObjects.Delete
Corona_Yeah_But_No_Virus msoShape4pointStar, 6, , msoLineThinThick
End Sub
Private Sub Corona_Yeah_But_No_Virus(Figure As MsoAutoShapeType, _
                        Optional Pas_Rotation As Integer = 4, _
                        Optional x As MsoLineDashStyle = 1, _
                        Optional y As MsoLineStyle = 1)
Dim shp As Shape, i%, j%
Set shp = ActiveSheet.Shapes.AddShape(Figure, 200, 100, 350, 350)
With shp
  .Fill.Visible = 0:  .Line.Weight = 0.65: .Line.DashStyle = x: .Line.Style = y:: .Line.Visible = -1
 For i = 0 To 359 \ Pas_Rotation
    With .Duplicate
       .Left = shp.Left: .Top = shp.Top
       .IncrementRotation (i * Pas_Rotation) Mod 360
       .Line.ForeColor.RGB = RGB(255 * Rnd, 255 * Rnd, 255 * Rnd)
      End With
 Next
 End With
End Sub

David Aubert · 16 Mai 2020

Bonjour JM, bonjour à tous,
Excellentes ces macros!!
Mon préféré c'est Gribouille 2

Bonne journée

Edit : finalement ce sont les résultats générés par la macro en post 22 que je préfère.
Le rendu est top, bravo JM!

Staple1600 · 22 Mai 2020

Bonsoir le fil, Bonsoir David

Adapté d'un code en Small Basic.

VB:

Sub Spirale()
Dim shp As Shape, f As Worksheet: Set f = ActiveSheet
Dim c As Double, X As Double, Y As Double, graines As Double
c = (Sqr(5) + 1) / 2: graines = 3000
For i = 0 To graines
    r = WorksheetFunction.Power(i, c) / graines
    Angle = 2 * WorksheetFunction.PI() * c * i
    vWH = i / graines * 10
    X = r * Sin(Angle) + 200: Y = r * Cos(Angle) + 200
        With f.Shapes.AddShape(msoShapeOval, X, Y, vWH, vWH)
            .Fill.Visible = 0: .Line.Weight = 0.25
        End With
Next
End Sub

Toujours dans le domaine du digressif, futile mais joli.

mapomme · 23 Mai 2020

Bonjour @Staple1600

Staple1600 à dit:
Toujours dans le domaine du digressif, futile mais joli.

Donc essentiel.
Histoire de faire des "ronds" dans l'eau

Staple1600 · 23 Mai 2020

Bonjour le fil, David

, mapomme

Mathématiquement futile, et un petit hommage à Maïtena Douménach (en passant)
(adapté d'un code VisualBasic, glané jadis sur une page web de l'Empire du Milieu)

VB:

Sub il_a_Neigé_sur_Yesterday()
FRK 130, 230, 190, 334: FRK 190, 334, 250, 230: FRK 250, 230, 130, 230
ActiveSheet.DrawingObjects.Group.Name = "Koch"
With ActiveSheet.Shapes("Koch")
    .LockAspectRatio = -1: .ScaleHeight 3, 0, 0
    .IncrementLeft -70.5: .IncrementTop -177
    .Line.ForeColor.ObjectThemeColor = 14
End With
[A1:H30].Interior.Color = vbBlack
End Sub
Private Sub FRK(aX As Single, aY As Single, bX As Single, bY As Single)
Dim cX!, cY!, dX!, dY!, eX!, eY!, l!, alpha!, shp As Shape
vPI = WorksheetFunction.PI()
If (bX - aX) * (bX - aX) + (bY - aY) * (bY - aY) < 10 Then
    Set shp = ActiveSheet.Shapes.AddLine(aX, aY, bX, bY)
Else
cX = aX + (bX - aX) / 3: cY = aY + (bY - aY) / 3: eX = bX - (bX - aX) / 3: eY = bY - (bY - aY) / 3
l = Sqr((eX - cX) * (eX - cX) + (eY - cY) * (eY - cY)): alpha = Atn((eY - cY) / (eX - cX))
        If (alpha >= 0 And (eX - cX) < 0) Or (alpha <= 0 And (eX - cX) < 0) Then
            alpha = alpha + vPI
        End If
    dY = cY + Sin(alpha + vPI / 3) * l: dX = cX + Cos(alpha + vPI / 3) * l
    FRK aX, aY, cX, cY: FRK eX, eY, bX, bY: FRK cX, cY, dX, dY: FRK dX, dY, eX, eY
End If
End Sub

Effectuez une recherche sur Excel Downloads...

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

Modeste geedee

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Geometry of the 4x4 Square

Staple1600

XLDnaute Barbatruc

Polyomino — Wikipédia

Staple1600

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

David Aubert

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums