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

[TooFatBoy]

Maudite boisson!

Certes, mais rassure-moi : j'ai bien compris ce que tu as dit en #63 ?
C'est bien comme ça que ça fonctionne ???

 

[garnote]

Certes, mais rassure-moi : j'ai bien compris ce que tu as dit en #63 ?
C'est bien comme ça que ça fonctionne ???

Tout à fait !

 

[garnote]

J'ai un plaisir fou à fréquenter ce site et bien sûr, c'est grâce à vous tous. Vos merveilles de macros, votre humour et toujours prêts à me venir en aide. Merci!

 

[TooFatBoy]

Dans la série: Trop de confinement dénature mon Excel
Mais au moins, si c'est futile, c'est joli, non ?

Waouh ! J'adore le Gribouille_1 !!!

 

[garnote]

Bonjour tout le monde,

Étant donné que chaque macro R_90, RV, RH, DP et DS contient ce même bout de code :

ReDim x(1 To n)
For Each cel In ici
i = i + 1
x(i) = cel.Interior.ColorIndex
Next cel

n'y aurait-il pas moyen d'éviter ces répétitions en confiant ce bout-là à une autre macro
qu'il me suffirait d'appeler? Et ci-joint mon fichier "Collection de fractales", renommé
et légèrement modifié. Promis, la dernière fois que je vous achale avec ça!

 

[TooFatBoy]

n'y aurait-il pas moyen d'éviter ces répétitions en confiant ce bout-là à une autre macro
qu'il me suffirait d'appeler?

Ben normalement si. Pourquoi ? Ca ne marche pas ?

 

[garnote]

Ben normalement si. Pourquoi ? Ca ne marche pas ?

J'ai essayé, mais sans succès!

 

[TooFatBoy]

J'ai essayé, mais sans succès!

Tu as peut-être oublié de déclarer x() en variable globale.

Pour info, chez moi ça sembler fonctionner sans problème.

Dim cel As Range
Dim ici As Range
Dim n As Long
Dim c As Long
Dim x() As Variant


Sub Départ()
    Set ici = Selection
    n = ici.Cells.Count
    c = Sqr(n)
    ReDim x(1 To n)
    For Each cel In ici
        i = i + 1
        x(i) = cel.Interior.ColorIndex
    Next cel
End Sub

Sub Identité()
'    Hahaha! Une macro qui ne fait rien.
    Application.ScreenUpdating = False
End Sub

Sub R_90()
    Application.ScreenUpdating = False
    Départ
    For i = c To 1 Step -1
        For j = 1 To c
            v = i + (j - 1) * c
            k = k + 1
            ici.Cells(k).Interior.ColorIndex = x(v)
        Next j
    Next i
End Sub

​

 

[garnote]

Tu as peut-être oublié de déclarer x() en variable globale.

Pour info, chez moi ça sembler fonctionner sans problème.

Dim cel As Range
Dim ici As Range
Dim n As Long
Dim c As Long
Dim x() As Variant


Sub Départ()
    Set ici = Selection
    n = ici.Cells.Count
    c = Sqr(n)
    ReDim x(1 To n)
    For Each cel In ici
        i = i + 1
        x(i) = cel.Interior.ColorIndex
    Next cel
End Sub

Sub Identité()
'    Hahaha! Une macro qui ne fait rien.
    Application.ScreenUpdating = False
End Sub

Sub R_90()
    Application.ScreenUpdating = False
    Départ
    For i = c To 1 Step -1
        For j = 1 To c
            v = i + (j - 1) * c
            k = k + 1
            ici.Cells(k).Interior.ColorIndex = x(v)
        Next j
    Next i
End Sub

Regarde la pièce jointe 1150987​

Merci, c'est en plein ça. Un nouveau Départ! . Je songe sérieusement à arrêter de picoler!
Et en passant, ton "Il y a 10 sortes de personnes : celles qui comprennent le binaire,
celles qui ne le comprennent pas." a fait un tabac sur Facebook!

 

[TooFatBoy]

Et en passant, ton "Il y a 10 sortes de personnes : celles qui comprennent le binaire,
celles qui ne le comprennent pas." a fait un tabac sur Facebook!

Ce n'est malheureusement pas de moi.

Je suis tombé, la semaine dernière, sur un gars (sur un autre forum) qui avait à peu près la même signature : ça disait la même chose mais tourné différemment.

 

[garnote]

Et j'en rajoute : 10 = 10 x 101 ! . Il est temps que j'aille me coucher!

 

[Staple1600]

Bonsoir le fil, @garnote, @TooFatBoy

Je ne m'en lasse pas
Maintenant comme faire ceci avec la méthode de @garnote, là je sèche dans les grandes largeurs.

Sub lime()
Application.ScreenUpdating = False
Grille
Mandelbrot
ActiveWindow.Zoom = 35
Application.ScreenUpdating = True
End Sub
Private Sub Grille()
Range("A1:OF396").ColumnWidth = 0.2
Range("A1:OF396").RowHeight = 2
End Sub
Private Sub Mandelbrot()
D = 99
For x = 1 To 4 * D
For y = 1 To 4 * D
p = 0: q = 0
For j = 1 To 98
c = 2 * p * q
p = p ^ 2 - q ^ 2 - 2 + (x - 1) / D
q = c + 2 + (1 - y) / D
If p ^ 2 + q ^ 2 >= 4 Then Exit For
Next j
j = -j * (j < D)
Cells(y, x).Interior.Color = Rnd(-j) * 1000000# * j / D
Next y, x
'crédits: Engine Toaster - septembre 2017
End Sub

Spoiler: Petit hommage à : La Minute nécessaire de monsieur Cyclopède

Vous reprendrez bien un petit peu de PowerShell ?

$M='System.Windows.Forms';nal n New-Object;Add-Type -A System.Drawing,$M;($a=n "$M.Form").backgroundimage=($b=n Drawing.Bitmap 300,300);0..299|%{$r=$_;0..299|%{$i=99;$k=$C=n numerics.complex($_/75-2),($r/75-2);while((($k=$k*$k).Magnitude-lt4)-and$i--){$k+=$C}$b.SetPixel($_,$r,-5e6*++$i)}};$a.Show()

Il ouvre PowerShell (en mode Console)
Il copie/colle la ligne de code ci-dessus
Il fait infuser son thé 61 secondes puis il regarde son écran
Etonnant, non ?

NB: C'est aussi une spéciale dédicace à Monsieur @TooFatBoy

 

[Staple1600]

Bonjour le fil,

Donnez-lui ses gouttes !!:
Il recommence

Spoiler: Si ça continue, il faudra que cela cesse!

Sub ito_Presto()
Application.ScreenUpdating = False
Range("A1:IW128").Clear
Cells.ColumnWidth = 2
Triangulons_un_1er_Octobre
Application.ScreenUpdating = True
End Sub
Sub Triangulons_un_1er_Octobre(Optional Waclaw_Franciszek_Sierpinski As String = "CéBO!")
Dim SunShine_Baby
Randomize 1600
SunShine_Baby = Choose(Int(7 * Rnd + 1), vbBlack, vbRed, vbBlue, vbGreen, vbYellow, vbMagenta, vbWhite)
Dim r As Range: Set r = Range("B2:IW128"): [DZ1] = 1
With r
    .Formula = "=IF(SUM(A1:C1)=1,1,"""")"
    .Value = .Value
        With .Offset(-1).Resize(128)
            .FormatConditions.Add 1, 3, "=1"
            .FormatConditions(1).Interior.Color = SunShine_Baby
        End With
End With
ActiveWindow.Zoom = 20
End Sub

PS: C'est la faute à @garnote au m'a fait replongé en réveillant cette discussion

 

[Dranreb]

Bonjour.
Une de mes vieilles images :

C'est au départ un .bmp réalisé par un classeur Excel disposant d'une routine permettant d'en écrire à partir de tableaux, avec ou sans palette (au cas où ça vous intéresserait de savoir y colorer des pixels plutôt que des cellules d'une feuille de calcul).

 

[Staple1600]

Bonjour Dranreb

Cela ressemble à l'ensemble de Julia, non ?

Et oui, bien sûr que je serais (et sans doute ceux qui passent dans ce fil) intéressé par cette routine et ce classeur.

Bienvenue dans ce fil