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

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Staple1600
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
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.
 
Re

@Dranreb
Voir cet exemple
(ici ma souris est sur Bleu sur Image1)
Couleurs.png
 
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:
@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. 😉
 
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
 
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! 🙄
 
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 😀 et j'ai presque obtenu la même chose que Jos avec ctrl + maj + J. 🙄
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

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
 
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! 😀 . 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: 55
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:
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.
 
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour