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

Dranreb

Dranreb

XLDnaute Barbatruc
Tu veux dire que la description de la teinte ne correspond pas à celle du pixel sélectionné dans l'image ?
Chez moi ça marche correctement. Juste pour l'affichage, seule la teinte de la couleur du LabInfo est conforme à cette description, à moins d'un clic droit ou si la touche Ctrl est enfoncée.
 
Staple1600

Staple1600

XLDnaute Barbatruc
Re

@Dranreb
Voir cet exemple
(ici ma souris est sur Bleu sur Image1)
Couleurs.png
 
Dranreb

Dranreb

XLDnaute Barbatruc
Pas toute la couleur non, seule sa composante A, la teinte, est conforme. Je ne changerai pas ça, car ça enlèverait une partie de la signalisation d'utilisation de la touche Ctrl ou d'un clic droit, visant à reproduire aussi toute les caractéristiques dans la couleur à changer.
Au fait, c'était peut être une erreur d'afficher le 3 UserForm car E ne dépend que d'un seul des 3, seul H et J nécessitent les 2 autres en même temps. Puis-je modifier pour n'afficher soit que E soit A et F ou tu est déjà trop habitué aux 3 ?
 
Dernière édition:
Staple1600

Staple1600

XLDnaute Barbatruc
@Dranreb
Ce n'était pas une critique

Je pensais que j'avais un problème d'écran. C'est tout.

C'est votre travail. Vous pouvez modifier ce que vous estimez devoir modifier.

Pour moi, c'est déjà un classeur magistral en l'état. ;)
 
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Puisqu'on parle folie et consorts
Alors une petite gaminerie
VB: 
Sub SolutionEtGribouillage()
Dim i
RAZ
For i = 1 To 14
Application.Run CStr("Poly" & i)
Next
ollyWood
End Sub
Sub RAZ()
Dim s As Shape
For Each s In ActiveSheet.Shapes
If s.Type = 5 Then
s.Delete
End If
Next
End Sub
Sub ollyWood()
Dim s As Shape
Randomize 1600
ps = Array(-2, 17, 20, 11, 2, 21, 3, 7, 12, 9, 24, 13, 23, 6, 1, 15, 18, 19, 14, 8, 16, 22, 5, 10, 4)(Application.RandBetween(1, 24))
For Each s In ActiveSheet.Shapes
If s.Type = 5 Then
conscient s, ps
End If
Next
End Sub
Sub conscient(s As Shape, x)
s.ShapeStyle = 67
With s.Glow
    .Color.ObjectThemeColor = 9: .Color.TintAndShade = 0: .Color.Brightness = 0
    .Transparency = 0.6000000238: .Radius = 8
    End With
    s.SoftEdge.Type = 3: s.ThreeD.BevelTopType = 3: s.ThreeD.BevelTopInset = 6: s.ThreeD.BevelTopDepth = 6
    With s.Fill
    .Visible = -1: .PresetTextured x: .TextureTile = -1
    .TextureOffsetX = 0: .TextureOffsetY = 0
    .TextureHorizontalScale = 1: .TextureVerticalScale = 1: .TextureAlignment = 0
End With
End Sub
 
garnote

garnote

XLDnaute Junior
Staple1600 à dit:
Re

Puisqu'on parle folie et consorts
Alors une petite gaminerie
VB: 
Sub SolutionEtGribouillage()
Dim i
RAZ
For i = 1 To 14
Application.Run CStr("Poly" & i)
Next
ollyWood
End Sub
Sub RAZ()
Dim s As Shape
For Each s In ActiveSheet.Shapes
If s.Type = 5 Then
s.Delete
End If
Next
End Sub
Sub ollyWood()
Dim s As Shape
Randomize 1600
ps = Array(-2, 17, 20, 11, 2, 21, 3, 7, 12, 9, 24, 13, 23, 6, 1, 15, 18, 19, 14, 8, 16, 22, 5, 10, 4)(Application.RandBetween(1, 24))
For Each s In ActiveSheet.Shapes
If s.Type = 5 Then
conscient s, ps
End If
Next
End Sub
Sub conscient(s As Shape, x)
s.ShapeStyle = 67
With s.Glow
    .Color.ObjectThemeColor = 9: .Color.TintAndShade = 0: .Color.Brightness = 0
    .Transparency = 0.6000000238: .Radius = 8
    End With
    s.SoftEdge.Type = 3: s.ThreeD.BevelTopType = 3: s.ThreeD.BevelTopInset = 6: s.ThreeD.BevelTopDepth = 6
    With s.Fill
    .Visible = -1: .PresetTextured x: .TextureTile = -1
    .TextureOffsetX = 0: .TextureOffsetY = 0
    .TextureHorizontalScale = 1: .TextureVerticalScale = 1: .TextureAlignment = 0
End With
End Sub
Cliquez pour agrandir...
Wow! Quel chic! Te reste à faire la même chose pour les 455 autres solutions! :rolleyes:
 
garnote

garnote

XLDnaute Junior
Bonsoir à tous,
Toujours dans "et consorts" :)
Ayant vu un "dessin" dans un livre avec comme explication : Une cardioïde peut-être obtenue comme l'enveloppe d'un segment joignant deux points d'un cercle, le premier tournant deux fois plus vite que le second. (Création de Jos Leys). Suite à de nombreuses réflexions et recherches, j'ai fini par comprendre la maudite phrase :D et j'ai presque obtenu la même chose que Jos avec ctrl + maj + J. :rolleyes:
Et ce site de Jos Leys vaut vraiment le détour pour les amateurs de fractales et autres folies!
Galleries (josleys.com)
Bonsoir, Bonne nuit !
 

Pièces jointes

  • Jos Leys cardioide.xlsm
    19.5 KB · Affichages: 5
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Oui, j'ignorais ceci
VB: 
Sub test_A()
Set shp = ActiveSheet.Shapes.AddLine(50, 100, 50, 200).Line
Dim sh_p As Shape
Set sh_p = ActiveSheet.Shapes.AddLine(75, 100, 75, 200)
End Sub
Sub test_B_Pas_OK()
Dim shp As Shape
Set shp = ActiveSheet.Shapes.AddLine(50, 50, 50, 50).Line
End Sub
Quel le petit plus du .Line ?

MP= message privé (désormais dans la nouvelle version du forum = Conversation)
(Si tu cliques sur l'enveloppe prés de ton pseudo, tu verras mon MP
 
garnote

garnote

XLDnaute Junior
Bonsoir à tous,

À partir de la cellule jaune, j'écris les entiers de 1 à ... en spirale dans le sens antihoraire.
Sur cette image j'en suis rendu à un tableau 7 x 7, mais je voudrais continuer la spirale.
Et comme j'aimerais obtenir des tableaux gigantesques :) , genre 203 x 203, je ne peux
imaginer faire ça à mains nues! :D . Je cherche une macro pour faire le boulot,
mais je n'y arrive pas. Vous avez une idée ou deux à ce sujet "et consorts" ?

Bonne fin de soirée!
 

Pièces jointes

  • Spirale de Ulam.PNG
    Spirale de Ulam.PNG
    6.8 KB · Affichages: 32
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir @garnote

En attendant les matheux pur jus, pour ta spirale "infernale" ;)

Voici en m'inspirant de ton classeur du message#204 et quelques lectures sur le net, un petit complément.
NB: lancez plusieurs fois la macro Test_A pour voir les variantes.
VB: 
Sub test_A()
ActiveSheet.DrawingObjects.Delete
Randomize 1600
DessinerCardioide 160, Application.RandBetween(0, 6)
End Sub
Sub test_B()
ActiveSheet.DrawingObjects.Delete
DessinerCardioide 500, 6
End Sub
Sub test_C()
ActiveSheet.DrawingObjects.Delete
DessinerCardioide 350, 51
End Sub

Private Sub DessinerCardioide(nbpts%, pas)
Dim r%, x0%, y0%, i%, j%, tablo As Variant, vPi As Double, TT As Double
Dim cercle As Shape, ligne As Shape
vPi = 4 * Atn(1): x0 = 250: y0 = 250: r = 200: npoints = nbpts: step = pas
'Ajout cercle
Set cercle = ActiveSheet.Shapes.AddShape(msoShapeOval, x0 - r, y0 - r, 2 * r, 2 * r)
cercle.Line.ForeColor.RGB = vbRed: cercle.Fill.ForeColor.RGB = vbBlack: cercle.Line.Weight = 0.1
ReDim tablo(1 To npoints, 1 To 2)
'Dessin points
For i = 1 To npoints
    TT = (i - 1) * 2 * vPi / npoints
    tablo(i, 1) = x0 + r * Cos(TT): tablo(i, 2) = y0 - r * Sin(TT)
    Set pts = ActiveSheet.Shapes.AddShape(9, tablo(i, 1) - 2, tablo(i, 2) - 2, 4, 4)
    pts.Line.ForeColor.RGB = vbBlue: pts.Fill.ForeColor.RGB = vbBlue
Next i
'Dessin Cardiode
j = npoints / 2 + 1
For i = 1 To npoints
Set ligne = ActiveSheet.Shapes.AddLine(tablo(i, 1), tablo(i, 2), tablo(j, 1), tablo(j, 2))
ligne.Line.ForeColor.RGB = vbRed: ligne.Line.Weight = 0.9
j = (j + step - 1) Mod npoints + 1
Next i
End Sub
'Crédits: garnote et Arnaldo Gunzi
 
Dernière édition:
garnote

garnote

XLDnaute Junior
Staple1600 à dit:
Bonsoir @garnote

En attendant les matheux pur jus, pour ta spirale "infernale" ;)

Voici en m'inspirant de ton classeur du message#204 et quelques lectures sur le net, un petit complément.
NB: lancez plus fois la macro Test_A pour voir les variantes.
VB: 
Sub test_A()
ActiveSheet.DrawingObjects.Delete
Randomize 1600
DessinerCardioide 160, Application.RandBetween(0, 6)
End Sub
Sub test_B()
ActiveSheet.DrawingObjects.Delete
DessinerCardioide 500, 6
End Sub
Sub test_C()
ActiveSheet.DrawingObjects.Delete
DessinerCardioide 350, 51
End Sub

Private Sub DessinerCardioide(nbpts%, pas)
Dim r%, x0%, y0%, i%, j%, tablo As Variant, vPi As Double, TT As Double
Dim cercle As Shape, ligne As Shape
vPi = 4 * Atn(1): x0 = 250: y0 = 250: r = 200: npoints = nbpts: step = pas
'Ajout cercle
Set cercle = ActiveSheet.Shapes.AddShape(msoShapeOval, x0 - r, y0 - r, 2 * r, 2 * r)
cercle.Line.ForeColor.RGB = vbRed: cercle.Fill.ForeColor.RGB = vbBlack: cercle.Line.Weight = 0.1
ReDim tablo(1 To npoints, 1 To 2)
'Dessin points
For i = 1 To npoints
    TT = (i - 1) * 2 * vPi / npoints
    tablo(i, 1) = x0 + r * Cos(TT): tablo(i, 2) = y0 - r * Sin(TT)
    Set pts = ActiveSheet.Shapes.AddShape(9, tablo(i, 1) - 2, tablo(i, 2) - 2, 4, 4)
    pts.Line.ForeColor.RGB = vbBlue: pts.Fill.ForeColor.RGB = vbBlue
Next i
'Dessin Cardiode
j = npoints / 2 + 1
For i = 1 To npoints
Set ligne = ActiveSheet.Shapes.AddLine(tablo(i, 1), tablo(i, 2), tablo(j, 1), tablo(j, 2))
ligne.Line.ForeColor.RGB = vbRed: ligne.Line.Weight = 0.9
j = (j + step - 1) Mod npoints + 1
Next i
End Sub
'Crédits: garnote et Arnaldo Gunzi
Cliquez pour agrandir...
Wow! De toute beauté et beaucoup de diversité. Je la copie pour tenter de la déchiffrer et la comprendre.
 

Membres actuellement en ligne

12 membres et 118 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 209
Messages
2 086 259
Membres
103 167
dernier inscrit
miriame