OVH Cloud OVH Cloud

[HS] Un mandala !

18 réponses
Avatar
garnote
Voilà ce qui arrive quand on trace
toutes les diagonales d'un polygone
régulier à 30 côtés ;-)
Etonnant, non !

Option Explicit

Sub Mandala()
Dim i As Integer, j As Integer
Dim k As Integer, p As Double
Dim d As Double
Dim tableau(1 To 1740, 1 To 2) As Double
Dim ici As Range
Application.ScreenUpdating = False
Application.DisplayFullScreen = True
Sheets.Add
Columns("A:B").Clear
p = WorksheetFunction.Pi
d = 2 * p / 30
For i = 1 To 30
For j = 2 To 30
k = k + 1
tableau(k, 1) = Cos(i * d)
tableau(k, 2) = Sin(i * d)
tableau(k + 1, 1) = Cos(j * d)
tableau(k + 1, 2) = Sin(j * d)
k = k + 1
Next j
Next i
Set ici = Range(Cells(1, 1), Cells(k, 2))
ici.Value = tableau
Charts.Add
With ActiveChart
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=ici, PlotBy:=xlColumns
.Location Where:=xlLocationAsNewSheet
.HasLegend = False
.PlotArea.ClearFormats
With .Axes(xlValue)
.MinimumScale = -1
.MaximumScale = 1
.MajorGridlines.Delete
.Delete
End With
.Axes(xlCategory).Delete
.SeriesCollection(1).Border.ColorIndex = 1
End With
ActiveChart.Deselect
ActiveWindow.Zoom = 100
'garnote, mars 2005.
End Sub

Salutations distinguees
Serge

10 réponses

1 2
Avatar
LSteph
Bonsoir S,
Impossible de quitter excel ou de sortir du Zoom Plus d'echap plus
CtrlBreak, plus de barres d'outils ..
.. j'ai terminé le processus et fort heureusement tout va bien...sinon

Merci , c'est beau...

Disons un magnifique Oeuf de Pâques vu d'en haut....

'lSteph

"garnote" a écrit dans le message de news:
%

Voilà ce qui arrive quand on trace
toutes les diagonales d'un polygone
régulier à 30 côtés ;-)
Etonnant, non !

Option Explicit

Sub Mandala()
Dim i As Integer, j As Integer
Dim k As Integer, p As Double
Dim d As Double
Dim tableau(1 To 1740, 1 To 2) As Double
Dim ici As Range
Application.ScreenUpdating = False
Application.DisplayFullScreen = True
Sheets.Add
Columns("A:B").Clear
p = WorksheetFunction.Pi
d = 2 * p / 30
For i = 1 To 30
For j = 2 To 30
k = k + 1
tableau(k, 1) = Cos(i * d)
tableau(k, 2) = Sin(i * d)
tableau(k + 1, 1) = Cos(j * d)
tableau(k + 1, 2) = Sin(j * d)
k = k + 1
Next j
Next i
Set ici = Range(Cells(1, 1), Cells(k, 2))
ici.Value = tableau
Charts.Add
With ActiveChart
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=ici, PlotBy:=xlColumns
.Location Where:=xlLocationAsNewSheet
.HasLegend = False
.PlotArea.ClearFormats
With .Axes(xlValue)
.MinimumScale = -1
.MaximumScale = 1
.MajorGridlines.Delete
.Delete
End With
.Axes(xlCategory).Delete
.SeriesCollection(1).Border.ColorIndex = 1
End With
ActiveChart.Deselect
ActiveWindow.Zoom = 100
'garnote, mars 2005.
End Sub

Salutations distinguees
Serge






Avatar
J
ouaouhhh, joli!!
j'avais déjà du mal à tracer celles d'un carré ;-))
J@@
"garnote" a écrit dans le message de news:
%

Voilà ce qui arrive quand on trace
toutes les diagonales d'un polygone
régulier à 30 côtés ;-)
Etonnant, non !

Option Explicit

Sub Mandala()
Dim i As Integer, j As Integer
Dim k As Integer, p As Double
Dim d As Double
Dim tableau(1 To 1740, 1 To 2) As Double
Dim ici As Range
Application.ScreenUpdating = False
Application.DisplayFullScreen = True
Sheets.Add
Columns("A:B").Clear
p = WorksheetFunction.Pi
d = 2 * p / 30
For i = 1 To 30
For j = 2 To 30
k = k + 1
tableau(k, 1) = Cos(i * d)
tableau(k, 2) = Sin(i * d)
tableau(k + 1, 1) = Cos(j * d)
tableau(k + 1, 2) = Sin(j * d)
k = k + 1
Next j
Next i
Set ici = Range(Cells(1, 1), Cells(k, 2))
ici.Value = tableau
Charts.Add
With ActiveChart
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=ici, PlotBy:=xlColumns
.Location Where:=xlLocationAsNewSheet
.HasLegend = False
.PlotArea.ClearFormats
With .Axes(xlValue)
.MinimumScale = -1
.MaximumScale = 1
.MajorGridlines.Delete
.Delete
End With
.Axes(xlCategory).Delete
.SeriesCollection(1).Border.ColorIndex = 1
End With
ActiveChart.Deselect
ActiveWindow.Zoom = 100
'garnote, mars 2005.
End Sub

Salutations distinguees
Serge






Avatar
Philippe.R
Bonjour Serge,
Superbement magique !
Encore un truc à en aimer les maths !
--
Amicales Salutations

"garnote" a écrit dans le message de news: %

Voilà ce qui arrive quand on trace
toutes les diagonales d'un polygone
régulier à 30 côtés ;-)
Etonnant, non !

Option Explicit

Sub Mandala()
Dim i As Integer, j As Integer
Dim k As Integer, p As Double
Dim d As Double
Dim tableau(1 To 1740, 1 To 2) As Double
Dim ici As Range
Application.ScreenUpdating = False
Application.DisplayFullScreen = True
Sheets.Add
Columns("A:B").Clear
p = WorksheetFunction.Pi
d = 2 * p / 30
For i = 1 To 30
For j = 2 To 30
k = k + 1
tableau(k, 1) = Cos(i * d)
tableau(k, 2) = Sin(i * d)
tableau(k + 1, 1) = Cos(j * d)
tableau(k + 1, 2) = Sin(j * d)
k = k + 1
Next j
Next i
Set ici = Range(Cells(1, 1), Cells(k, 2))
ici.Value = tableau
Charts.Add
With ActiveChart
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=ici, PlotBy:=xlColumns
.Location Where:=xlLocationAsNewSheet
.HasLegend = False
.PlotArea.ClearFormats
With .Axes(xlValue)
.MinimumScale = -1
.MaximumScale = 1
.MajorGridlines.Delete
.Delete
End With
.Axes(xlCategory).Delete
.SeriesCollection(1).Border.ColorIndex = 1
End With
ActiveChart.Deselect
ActiveWindow.Zoom = 100
'garnote, mars 2005.
End Sub

Salutations distinguees
Serge






Avatar
JièL Goubert
Bonjoir(c) garnote

jolie... mais c'est pas en couleur ? :-(
;-))

JièL en rose

Le 27/03/2005 22:30 vous avez écrit ceci :
Voilà ce qui arrive quand on trace
toutes les diagonales d'un polygone
régulier à 30 côtés ;-)
Etonnant, non !

Option Explicit

Sub Mandala()
Dim i As Integer, j As Integer
Dim k As Integer, p As Double
Dim d As Double
Dim tableau(1 To 1740, 1 To 2) As Double
Dim ici As Range
Application.ScreenUpdating = False
Application.DisplayFullScreen = True
Sheets.Add
Columns("A:B").Clear
p = WorksheetFunction.Pi
d = 2 * p / 30
For i = 1 To 30
For j = 2 To 30
k = k + 1
tableau(k, 1) = Cos(i * d)
tableau(k, 2) = Sin(i * d)
tableau(k + 1, 1) = Cos(j * d)
tableau(k + 1, 2) = Sin(j * d)
k = k + 1
Next j
Next i
Set ici = Range(Cells(1, 1), Cells(k, 2))
ici.Value = tableau
Charts.Add
With ActiveChart
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=ici, PlotBy:=xlColumns
.Location Where:=xlLocationAsNewSheet
.HasLegend = False
.PlotArea.ClearFormats
With .Axes(xlValue)
.MinimumScale = -1
.MaximumScale = 1
.MajorGridlines.Delete
.Delete
End With
.Axes(xlCategory).Delete
.SeriesCollection(1).Border.ColorIndex = 1
End With
ActiveChart.Deselect
ActiveWindow.Zoom = 100
'garnote, mars 2005.
End Sub

Salutations distinguees
Serge


Avatar
idrevetnom
Très beau! très joli! Impressionant de compétences avec Excel!

Juste un petit truc, SVP, pouvez vous dire comment faire pour récupérer
l'affichage traditionnel qui a disparu?

Je n'arrive plus à accéder aux onglets, et il n'y a plus de barre titre tout
en haut, et ceci sur tous mes fichiers , même après fermeture réouverture
d'Excel, bon, ça n'est pas grave, mais ça m'ennuie un petit peu, et puis je
vais sûrement apprendre encore qqch que je ne connaissais pas sur ce forum
magnifique!

Merci d'avance
Avatar
idrevetnom
Autant pour moi, j'ai tout récupéré pour l'affichage, il suffisait de
cliquer "au bord" de l'écran!
Avatar
jps
garnote, geedee, même combat
quand tu fais tourner une de leurs procs, c'est la chienlit....
et préviennent jamais ces bougres à tel point que ma corbeille est pleine
des chefs d'oeuvre du prof québécois et de cette espèce d'anichois (ne lisez
pas trop vite, vous ne verriez pas le "i".... encore que le sens resterait
valable)
jps

"idrevetnom" a écrit dans le message de
news:eJx$
Très beau! très joli! Impressionant de compétences avec Excel!

Juste un petit truc, SVP, pouvez vous dire comment faire pour récupérer
l'affichage traditionnel qui a disparu?

Je n'arrive plus à accéder aux onglets, et il n'y a plus de barre titre
tout

en haut, et ceci sur tous mes fichiers , même après fermeture réouverture
d'Excel, bon, ça n'est pas grave, mais ça m'ennuie un petit peu, et puis
je

vais sûrement apprendre encore qqch que je ne connaissais pas sur ce forum
magnifique!

Merci d'avance




Avatar
twinley
Bravo, jolie figure de style...
La création du tableau est bien belle aussi.


à+twinley

Voilà ce qui arrive quand on trace
toutes les diagonales d'un polygone
régulier à 30 côtés ;-)
Etonnant, non !

Option Explicit

Sub Mandala()
Dim i As Integer, j As Integer
Dim k As Integer, p As Double
Dim d As Double
Dim tableau(1 To 1740, 1 To 2) As Double
Dim ici As Range
Application.ScreenUpdating = False
Application.DisplayFullScreen = True
Sheets.Add
Columns("A:B").Clear
p = WorksheetFunction.Pi
d = 2 * p / 30
For i = 1 To 30
For j = 2 To 30
k = k + 1
tableau(k, 1) = Cos(i * d)
tableau(k, 2) = Sin(i * d)
tableau(k + 1, 1) = Cos(j * d)
tableau(k + 1, 2) = Sin(j * d)
k = k + 1
Next j
Next i
Set ici = Range(Cells(1, 1), Cells(k, 2))
ici.Value = tableau
Charts.Add
With ActiveChart
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=ici, PlotBy:=xlColumns
.Location Where:=xlLocationAsNewSheet
.HasLegend = False
.PlotArea.ClearFormats
With .Axes(xlValue)
.MinimumScale = -1
.MaximumScale = 1
.MajorGridlines.Delete
.Delete
End With
.Axes(xlCategory).Delete
.SeriesCollection(1).Border.ColorIndex = 1
End With
ActiveChart.Deselect
ActiveWindow.Zoom = 100
'garnote, mars 2005.
End Sub

Salutations distinguees
Serge






Avatar
gamma60
twinley wrote:
Bravo, jolie figure de style...
La création du tableau est bien belle aussi.

justement je n'arrive pas à visualiser la création du tableau

un clic et c'est fait
je voudrais qu'il prenne qq secondes pour se faire
que dois-je rajouter ?
merci

--
gamma60

Avatar
GD
Bonsour®JièL©
;o)))
Ah... t'en veux des couleurs ????
ben tient en voila !!!
http://cjoint.com/?dCvEd4bMCU

;o)))
Goubert wrote:
Bonjoir(c) garnote
jolie... mais c'est pas en couleur ? :-(
;-))
JièL en rose


1 2