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

[Staple1600]

Bonjour à tous

Confiné, pour confiné, confinons carrément en couleurs
Ce fil prends sa source dans Lien supprimé initié par clemendo51.
Il a juste vocation à éviter d'encombrer le fil initial

A vos crayons de couleurs
Digressons, digressons dans nos petits modules.

Suite de là où je m'étais arrêté dans l'autre fil.
Je change mon fusil d'épaule sur ce coup là

Const Umma As String = "A:A,C:C,E:E,G:G,I:I"
Const Gumma As String = "1:1,3:3,5:5,7:7,9:9"
Sub O_My_Grid()
Dim R As Range: Set R = [A1:I9]: R.ColumnWidth = 4: R.RowHeight = [A1].Width: R.Interior.Color = vbBlue
With Intersect(Range(Umma).EntireColumn, Range(Gumma).EntireRow): .Interior.Color = 255: End With
End Sub

Spoiler: Ci-dessous les codes "digressifs" postés dans l'autre fil

Sub Not_X_Cross()
Dim R As Range, Tb(1 To 9, 1 To 9), i%, j%: Set R = Range("A1:I9")
For i = LBound(Tb, 1) To UBound(Tb, 1): For j = LBound(Tb, 2) To UBound(Tb, 2): Tb(i, j) = i * j Mod 5: Next j: Next i
With R
    .ColumnWidth = 4: .RowHeight = .Item(1).Width: .Value = Tb
    .FormatConditions.Add xlCellValue, xlEqual, Formula1:="=0"
    With .FormatConditions(1): .Interior.Color = 255: .Font.Color = 255: End With
    .FormatConditions.Add xlCellValue, xlGreater, Formula1:="=0"
    With .FormatConditions(2): .Interior.Color = vbBlue: .Font.Color = vbBlue: End With
End With
End Sub

Sub carré_avec_des_endives() ' effet collatéral du Grand Confinement du 2020
With Cells(1).Resize(9, 9): .ColumnWidth = .ColumnWidth / (.Item(1).Width / .Item(1).Height): End With
End Sub

Sub Red_Diago()
Dim R As Range, Tb, vMFC, i&, j&, k&: Cells.Delete: Set R = Range("A1:I9"): R.Clear: R.Value = 0: Tb = R.Value
vMFC = Array(Array(6, vbYellow), Array(3, 255), Array(5, vbGreen))
For i = LBound(Tb, 1) To UBound(Tb, 1): For j = LBound(Tb, 2) To UBound(Tb, 2): Tb(i, j) = i Mod 10 - j: Next j: Next i
R.Value = Tb: R.ColumnWidth = 4: R.RowHeight = [a1].Width
For k = 0 To 2: R.FormatConditions.Add 1, vMFC(k)(0), "=0"
With R.FormatConditions(k + 1): .Font.Color = vMFC(k)(1): .Interior.Color = vMFC(k)(1): End With
Next
End Sub

Sub Blue_Line()
Dim R As Range: Cells.Delete: Set R = [A1:I9]: R.Value = [=MUNIT(9)]: R.ColumnWidth = 4: R.RowHeight = [a1].Width
R.FormatConditions.Add 1, 3, "=0": R.FormatConditions.Add 1, 5, "=0"
With R.FormatConditions(1): .Interior.Color = 255: .Font.Color = 255: End With
With R.FormatConditions(2): .Interior.Color = vbBlue: .Font.Color = vbBlue: End With
End Sub

 

[patricktoulon]

re
tiens une simple les couleur montent

Sub down_color()
    Dim R As Range: Cells.Delete: Set R = [A1:I9]:: R.ColumnWidth = 4: R.RowHeight = [A1].Width
    a = 2
    For x = 2 To 56 - 9
        a = x
        For i = 1 To 9
            a = a + 1
            Cells(i, i).Resize(10 - i, 10 - i).Interior.ColorIndex = a
        Next
        Application.Wait Now + 0.00001
    Next
End Sub

 

[Staple1600]

Re

Merci de te joindre au truc
(PS: Tu as testé le code du premier message ?)
Ci-dessous, j'ai repris ton idée de formule.

Const Fz As String = "=(MOD(ROW(),R1C11)=MOD(COLUMN(),R1C12))"
Sub K_Ré_Color(Optional X As Long = 2)
Dim R As Range: [K1] = X: [L1] = X - 1: Set R = [A1:I9]: R.Formula = Fz: R.ColumnWidth = 4: R.RowHeight = [a1].Width: R.FormatConditions.Add 1, 3, "=VRAI"
R.Interior.Color = vbWhite: R.Font.Color = vbWhite: With R.FormatConditions(1): .Interior.Color = vbBlack: .Font.Color = vbBlack: End With
End Sub

Private Sub CommandButton1_Click()
Randomize 1600
K_Ré_Color Application.RandBetween(2, 9)
End Sub

Et j'ai ajouté sur un CommandButton pour cliquer, cliquer, cliquer, cliquer et recliquer

NB: Comme tu le dis dans le fil de clemendo51, le confinement nous attaque gravement les neurones

 

[patricktoulon]

oui j'ai testé le premier code
j'avais compris l'effet avant même d'essayer
celui là aussi est pas mal

je vais voir si on peut réunir les deux segment de droite a chaque ligne

 

[patricktoulon]

en attendant voila celle ci

Sub ocille()
    Dim R As Range: [K1] = x: [L1] = x - 1: Set R = [A1:I9]: R.ColumnWidth = 4: R.RowHeight = [a1].Width: R.FormatConditions.Add 1, 3, "=VRAI"
    R.FormatConditions.Add xlCellValue, xlEqual, Formula1:="VRAI"
    With R.FormatConditions(1): .Interior.Color = 255: .Font.Color = 255: End With
    For i = 2 To 5
        Fz = "=OU(MOD(LIGNE();" & i & ")=0;LIGNE()=" & IIf(x > 2, 1, i) & ")"
        R.FormulaLocal = Fz:

        Application.Wait Now + 0.00001
    Next
End Sub

 

[Staple1600]

Re

Si ça continue, il faudra que cela cesse...

Sub True_Colors()
Dim Tb(1 To 9, 1 To 9), R As Range, X&: Set R = [A1:I9]: R.NumberFormat = ";;;"
Randomize 1600:  R = Empty: R.ColumnWidth = 4: R.RowHeight = [A1].Width
X = Application.RandBetween(1, 9): Z = Application.RandBetween(0, 2): op = Split("+ * -")(Z)
For i = 1 To 9: For J = 1 To 9: Tb(i, J) = Evaluate(CStr(i) & op & CStr(J)) Mod X = 0: Next J: Next i
R.Value = Tb
End Sub

 

[Staple1600]

Re

J'avais oublié la MFC dans le message précédent.
Donc cette fois, je scinde (donc je rallonge )

Sub Black_Is_Black()
Dim AA, BB, tCols
tCols = Array(vbBlack, vbRed, vbGreen, vbBlue, vbYellow, vbMagenta, vbCyan)
AA = tCols(Application.RandBetween(0, 6))
BB = tCols(Application.RandBetween(0, 6))
mMFC Range("A1:I9"), AA, BB
True_Colors
End Sub
Private Sub True_Colors()
Dim Tb(1 To 9, 1 To 9), R As Range, X&: Set R = [A1:I9]: R.NumberFormat = ";;;"
Randomize 1600:  R = Empty: R.ColumnWidth = 4: R.RowHeight = [A1].Width
X = Application.RandBetween(1, 9): Z = Application.RandBetween(0, 2): op = Split("+ * -")(Z)
For i = 1 To 9: For J = 1 To 9: Tb(i, J) = Evaluate(CStr(i) & op & CStr(J)) Mod X = 0: Next J: Next i
R.Value = Tb
End Sub
Private Sub mMFC(R As Range, vColorA, vColorB)
R.FormatConditions.Delete
R.FormatConditions.Add 1, 3, "=VRAI": R.FormatConditions(1).Interior.COLOR = vColorA
R.FormatConditions.Add 1, 3, "=FAUX": R.FormatConditions(2).Interior.COLOR = vColorB
End Sub

PS: Il faut lancer la macro plusieurs fois pour en voir de toutes les couleurs

 

[patricktoulon]

re

Si ça continue, il faudra que cela cesse.

 

[Staple1600]

Re

Si tu l'as dans ta besace ou dans ton cortex, je cherche le nombre de coloriage possible d'un carré de 9x9 avec seulement 2 couleurs.
(Parce que là, il est trop tard pour moi pour faire des maths)
Bonne nuit.

 

[mapomme]

Bonjour @Staple1600 , @patricktoulon ,

le nombre de coloriage possible d'un carré de 9x9 avec seulement 2 couleurs.

Pour chaque case, on a deux possibilités d'où en tout 2^81? Ça fait très beaucoup plus
J'ai bon ?

 

[patricktoulon]

re bonsoir mapomme
ben si on raisonne entièrement ca va bien plus loin que 2^81 et c'est plutôt 72 sinon il y aurait des doublons
vu que pour le nombre de couleur on est déjà pas mal *(9*8) et *(9*8)-1 pour les couples de cellules
je dirais donc que ça fait 2^(9*8) * le nombre de couleurs dispos pour excel

 

[Staple1600]

Bonsoir mapomme, patricktoulon

Je me suis mal exprimé sans doute.
Je voulais combien de "pattern distincts" (sans compter les symétries)
On peut réduire prendre un échiquier de 8x8 pour réduire.
Exemple
L'échiquier= 1 pattern
La croix=1 pattern
Le X=1 pattern
Le U=1 pattern
etc...

>patricktoulon
Je ne veux prendre que deux couleurs et "dessiner" les patterns sans symetrie, ni rotation.

 

[mapomme]

Re,

Si tu veux une solution "pattern", il faut qu'on soit brillant ? Bon je sors...

 

[patricktoulon]

on pourrait se contenté de trouver les couples et appliquer un rnd pour la couleur
ce qui nous ramène a 3240 couple de cellules sans doublons

 

[Staple1600]

Re

Je reprends un exemple
1) L'échiquier est noir
2) A1->blanc
3)B1:A2->blanc
4)C1:A3->blanc
...
9)I1:A9->blanc
Bref ce sont les diagonales.
Donc on ne comptera pas l'autre moitié puisque symétrique.