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

Staple1600 · 4 Avril 2020

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à 😉

VB:

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

VB:

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

VB:

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

VB:

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

VB:

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 · 4 Avril 2020

re
tiens une simple les couleur montent

VB:

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 · 4 Avril 2020

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.

VB:

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 · 4 Avril 2020

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 · 4 Avril 2020

en attendant voila celle ci

VB:

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 · 5 Avril 2020

Re

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

VB:

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 · 5 Avril 2020

Re

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

VB:

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 · 5 Avril 2020

re

Si ça continue, il faudra que cela cesse.

😀 😀 😀 😎 😀

Staple1600 · 5 Avril 2020

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 · 6 Avril 2020

Bonjour @Staple1600 🙂, @patricktoulon 🙂,

Staple1600 à dit:
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 · 6 Avril 2020

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 · 6 Avril 2020

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 · 6 Avril 2020

Re,

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

patricktoulon · 6 Avril 2020

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 · 6 Avril 2020

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.

Effectuez une recherche sur Excel Downloads...

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

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Nous accordons de l'importance à votre vie privée