OVH Cloud OVH Cloud

Pour le plaisir de se compliquer la vie !

5 réponses
Avatar
garnote
Santé à tous et réveillonnons !

Sub Une_Série_De_Noel()
Application.ScreenUpdating = False
On Error Resume Next
Dim x As Variant
Dim y As Variant
x = Array(4, 4, 3, 3, "", 5, 7, 7, 5, 5, "", _
8, 9, 10, "", 9, 9, "", 12, 11, 11, 12, "", 11, _
11, 12, "", 13, 13, 15, 15, "", 16, 17, 18, "", _
16, 17, 18, "", 5, 5, 7, 7, "", 8, 8, 10, 10, 8, "", _
12, 11, 11, 12, "", 11, 11, 12, "", 13, 13, 15, "", _
16, 16, "", 16)
y = Array(4, 2.5, 2.5, 3, "", 3.5, 3.5, 2.5, 2.5, 3.5, _
"", 3.5, 3, 3.5, "", 2.5, 3, "", 3.5, 3.5, 3, 3, "", 3, _
2.5, 2.5, "", 3.5, 2.5, 2.5, 3.5, "", 3.5, 3, 3.5, "", _
2.5, 3, 2.5, "", 0.5, 1.5, 0.5, 1.5, "", 0.5, 1.5, 1.5, _
0.5, 0.5, "", 1.5, 1.5, 1, 1, "", 1, 0.5, 0.5, "", 1.5, _
0.5, 0.5, "", 1.5, 0.75, "", 0.5)
For i = 0 To 67
Cells(i + 1, 1) = x(i)
Cells(i + 1, 2) = y(i)
Next i
ici = ActiveSheet.Name
Charts.Add
With ActiveChart
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=Sheets(ici).Range("a1:b68"), _
PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, Name:=ici
End With
With ActiveChart.SeriesCollection(1).Border
.ColorIndex = 3
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With ActiveChart.SeriesCollection(1).Points(68)
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
.MarkerStyle = xlCircle
.MarkerSize = 5
End With
With ActiveChart
.Axes(xlValue).MajorGridlines.Delete
.Axes(xlCategory).Delete
.Axes(xlValue).Delete
.Legend.Delete
End With
With ActiveChart.PlotArea
.Fill.PresetTextured PresetTexture:=msoTextureParchment
.Fill.Visible = True
End With
ActiveWindow.Visible = False
ActiveWindow.Activate
ActiveWindow.DisplayGridlines = False
Range("a1").Select
End Sub

;-)))
Serge

5 réponses

Avatar
MacBob
Salut Serge

Noyeux Joël j'ai compris mais les deux colonnes de chiffres en a et b c'est
quoi? Une énigme à résoudre ou un repas trop arrosé à l'avance?

MacBob 8°)))


Le 24/12/03 19:14, dans eIkGb.1512$, « garnote »
a écrit :

Sub Une_Série_De_Noel()
Application.ScreenUpdating = False
On Error Resume Next
Dim x As Variant
Dim y As Variant
x = Array(4, 4, 3, 3, "", 5, 7, 7, 5, 5, "", _
8, 9, 10, "", 9, 9, "", 12, 11, 11, 12, "", 11, _
11, 12, "", 13, 13, 15, 15, "", 16, 17, 18, "", _
16, 17, 18, "", 5, 5, 7, 7, "", 8, 8, 10, 10, 8, "", _
12, 11, 11, 12, "", 11, 11, 12, "", 13, 13, 15, "", _
16, 16, "", 16)
y = Array(4, 2.5, 2.5, 3, "", 3.5, 3.5, 2.5, 2.5, 3.5, _
"", 3.5, 3, 3.5, "", 2.5, 3, "", 3.5, 3.5, 3, 3, "", 3, _
2.5, 2.5, "", 3.5, 2.5, 2.5, 3.5, "", 3.5, 3, 3.5, "", _
2.5, 3, 2.5, "", 0.5, 1.5, 0.5, 1.5, "", 0.5, 1.5, 1.5, _
0.5, 0.5, "", 1.5, 1.5, 1, 1, "", 1, 0.5, 0.5, "", 1.5, _
0.5, 0.5, "", 1.5, 0.75, "", 0.5)
For i = 0 To 67
Cells(i + 1, 1) = x(i)
Cells(i + 1, 2) = y(i)
Next i
ici = ActiveSheet.Name
Charts.Add
With ActiveChart
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=Sheets(ici).Range("a1:b68"), _
PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, Name:=ici
End With
With ActiveChart.SeriesCollection(1).Border
.ColorIndex = 3
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With ActiveChart.SeriesCollection(1).Points(68)
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
.MarkerStyle = xlCircle
.MarkerSize = 5
End With
With ActiveChart
.Axes(xlValue).MajorGridlines.Delete
.Axes(xlCategory).Delete
.Axes(xlValue).Delete
.Legend.Delete
End With
With ActiveChart.PlotArea
.Fill.PresetTextured PresetTexture:=msoTextureParchment
.Fill.Visible = True
End With
ActiveWindow.Visible = False
ActiveWindow.Activate
ActiveWindow.DisplayGridlines = False
Range("a1").Select
End Sub


Avatar
garnote
C'est pour alimenter mon nuage de points, voyons ;-)))
Et quelle horreur, j'avais oublié les trémas !
Quant à l'arrosage, je m'y mets.
Un ti rhum pour commencer.
Joyeux Léon !

Sub Une_Série_De_Noël_Avec_Trémas()
Application.ScreenUpdating = False
On Error Resume Next
Dim x As Variant
Dim y As Variant
x = Array(4, 4, 3, 3, "", 5, 7, 7, 5, 5, "", _
8, 9, 10, "", 9, 9, "", 12, 11, 11, 12, "", 11, _
11, 12, "", 13, 13, 15, 15, "", 16, 17, 18, "", _
16, 17, 18, "", 5, 5, 7, 7, "", 8, 8, 10, 10, 8, "", _
12, 11, 11, 12, "", 11, 11, 12, "", 13, 13, 15, "", _
16, 16, "", 16, "", 11.25, "", 11.75)
y = Array(4, 2.5, 2.5, 3, "", 3.5, 3.5, 2.5, 2.5, 3.5, _
"", 3.5, 3, 3.5, "", 2.5, 3, "", 3.5, 3.5, 3, 3, "", 3, _
2.5, 2.5, "", 3.5, 2.5, 2.5, 3.5, "", 3.5, 3, 3.5, "", _
2.5, 3, 2.5, "", 0.5, 1.5, 0.5, 1.5, "", 0.5, 1.5, 1.5, _
0.5, 0.5, "", 1.5, 1.5, 1, 1, "", 1, 0.5, 0.5, "", 1.5, _
0.5, 0.5, "", 1.5, 0.75, "", 0.5, "", 1.75, "", 1.75)
For i = 0 To 71
Cells(i + 1, 1) = x(i)
Cells(i + 1, 2) = y(i)
Next i
ici = ActiveSheet.Name
Charts.Add
With ActiveChart
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=Sheets(ici).Range("a1:b72"), _
PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, Name:=ici
End With
With ActiveChart.SeriesCollection(1).Border
.ColorIndex = 3
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With ActiveChart.SeriesCollection(1)
For i = 1 To 2
With .Points(68 + 2 * i)
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
.MarkerStyle = xlCircle
.MarkerSize = 3
End With
Next i
With .Points(68)
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
.MarkerStyle = xlCircle
.MarkerSize = 5
End With
End With
With ActiveChart
.Axes(xlValue).MajorGridlines.Delete
.Axes(xlCategory).Delete
.Axes(xlValue).Delete
.Legend.Delete
End With
With ActiveChart.PlotArea
.Fill.PresetTextured PresetTexture:=msoTextureParchment
.Fill.Visible = True
End With
ActiveWindow.Visible = False
ActiveWindow.Activate
ActiveWindow.DisplayGridlines = False
Range("a1").Select
End Sub

Serge

"MacBob" a écrit dans le message
de news: BC0F9738.7C4B%
Salut Serge

Noyeux Joël j'ai compris mais les deux colonnes de chiffres en a et b
c'est

quoi? Une énigme à résoudre ou un repas trop arrosé à l'avance?

MacBob 8°)))


Avatar
MacBob
Allez! On les fait disparaître ces chiffres?

(En espérant que le code des couleurs est le même sur Mac que sur PC).

Bien sur la méthode n'est pas très élégante mais on fait avec ce qu'on a...

Sub Une_Série_De_Noel()
Application.ScreenUpdating = False
On Error Resume Next
Columns("A:B").Select
Selection.Font.ColorIndex = 2
Dim x As Variant
Dim y As Variant
x = Array(4, 4, 3, 3, "", 5, 7, 7, 5, 5, "", _
8, 9, 10, "", 9, 9, "", 12, 11, 11, 12, "", 11, _
11, 12, "", 13, 13, 15, 15, "", 16, 17, 18, "", _
16, 17, 18, "", 5, 5, 7, 7, "", 8, 8, 10, 10, 8, "", _
12, 11, 11, 12, "", 11, 11, 12, "", 13, 13, 15, "", _
16, 16, "", 16, "", 11.25, "", 11.75)
y = Array(4, 2.5, 2.5, 3, "", 3.5, 3.5, 2.5, 2.5, 3.5, _
"", 3.5, 3, 3.5, "", 2.5, 3, "", 3.5, 3.5, 3, 3, "", 3, _
2.5, 2.5, "", 3.5, 2.5, 2.5, 3.5, "", 3.5, 3, 3.5, "", _
2.5, 3, 2.5, "", 0.5, 1.5, 0.5, 1.5, "", 0.5, 1.5, 1.5, _
0.5, 0.5, "", 1.5, 1.5, 1, 1, "", 1, 0.5, 0.5, "", 1.5, _
0.5, 0.5, "", 1.5, 0.75, "", 0.5, "", 1.75, "", 1.75)
For i = 0 To 71
Cells(i + 1, 1) = x(i)
Cells(i + 1, 2) = y(i)
Next i
ici = ActiveSheet.Name
Charts.Add
With ActiveChart
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=Sheets(ici).Range("a1:b72"), _
PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, Name:=ici
End With
With ActiveChart.SeriesCollection(1).Border
.ColorIndex = 3
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With ActiveChart.SeriesCollection(1)
For i = 1 To 2
With .Points(68 + 2 * i)
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
.MarkerStyle = xlCircle
.MarkerSize = 3
End With
Next i
With .Points(68)
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
.MarkerStyle = xlCircle
.MarkerSize = 5
End With
End With
With ActiveChart
.Axes(xlValue).MajorGridlines.Delete
.Axes(xlCategory).Delete
.Axes(xlValue).Delete
.Legend.Delete
End With
With ActiveChart.PlotArea
.Fill.PresetTextured PresetTexture:=msoTextureParchment
.Fill.Visible = True
End With
ActiveWindow.Visible = False
ActiveWindow.Activate
ActiveWindow.DisplayGridlines = False
Range("a1").Select
End Sub

MacBob 8°)))
Avatar
garnote
Plus élégant ainsi !

Serge


"MacBob" a écrit dans le message
de news: BC0FA433.7C5F%
Allez! On les fait disparaître ces chiffres?

(En espérant que le code des couleurs est le même sur Mac que sur PC).

Bien sur la méthode n'est pas très élégante mais on fait avec ce qu'on
a...


Sub Une_Série_De_Noel()
Application.ScreenUpdating = False
On Error Resume Next
Columns("A:B").Select
Selection.Font.ColorIndex = 2
Dim x As Variant
Dim y As Variant
x = Array(4, 4, 3, 3, "", 5, 7, 7, 5, 5, "", _
8, 9, 10, "", 9, 9, "", 12, 11, 11, 12, "", 11, _
11, 12, "", 13, 13, 15, 15, "", 16, 17, 18, "", _
16, 17, 18, "", 5, 5, 7, 7, "", 8, 8, 10, 10, 8, "", _
12, 11, 11, 12, "", 11, 11, 12, "", 13, 13, 15, "", _
16, 16, "", 16, "", 11.25, "", 11.75)
y = Array(4, 2.5, 2.5, 3, "", 3.5, 3.5, 2.5, 2.5, 3.5, _
"", 3.5, 3, 3.5, "", 2.5, 3, "", 3.5, 3.5, 3, 3, "", 3, _
2.5, 2.5, "", 3.5, 2.5, 2.5, 3.5, "", 3.5, 3, 3.5, "", _
2.5, 3, 2.5, "", 0.5, 1.5, 0.5, 1.5, "", 0.5, 1.5, 1.5, _
0.5, 0.5, "", 1.5, 1.5, 1, 1, "", 1, 0.5, 0.5, "", 1.5, _
0.5, 0.5, "", 1.5, 0.75, "", 0.5, "", 1.75, "", 1.75)
For i = 0 To 71
Cells(i + 1, 1) = x(i)
Cells(i + 1, 2) = y(i)
Next i
ici = ActiveSheet.Name
Charts.Add
With ActiveChart
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=Sheets(ici).Range("a1:b72"), _
PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, Name:=ici
End With
With ActiveChart.SeriesCollection(1).Border
.ColorIndex = 3
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With ActiveChart.SeriesCollection(1)
For i = 1 To 2
With .Points(68 + 2 * i)
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
.MarkerStyle = xlCircle
.MarkerSize = 3
End With
Next i
With .Points(68)
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
.MarkerStyle = xlCircle
.MarkerSize = 5
End With
End With
With ActiveChart
.Axes(xlValue).MajorGridlines.Delete
.Axes(xlCategory).Delete
.Axes(xlValue).Delete
.Legend.Delete
End With
With ActiveChart.PlotArea
.Fill.PresetTextured PresetTexture:=msoTextureParchment
.Fill.Visible = True
End With
ActiveWindow.Visible = False
ActiveWindow.Activate
ActiveWindow.DisplayGridlines = False
Range("a1").Select
End Sub

MacBob 8°)))



Avatar
Leo
Complètement inutile, mais excellent et donc indispensable. ;-)

Bravo,

--


Amicalement,
Leo
---------------------------------------------
Pour les riders, BMX, VTT. Un seul site :
Little Big Trail : http://perso.wanadoo.fr/lbt/
---------------------------------------------

"garnote" a écrit dans le message de
news:eIkGb.1512$

Santé à tous et réveillonnons !

Sub Une_Série_De_Noel()
Application.ScreenUpdating = False
On Error Resume Next
Dim x As Variant
Dim y As Variant
x = Array(4, 4, 3, 3, "", 5, 7, 7, 5, 5, "", _
8, 9, 10, "", 9, 9, "", 12, 11, 11, 12, "", 11, _
11, 12, "", 13, 13, 15, 15, "", 16, 17, 18, "", _
16, 17, 18, "", 5, 5, 7, 7, "", 8, 8, 10, 10, 8, "", _
12, 11, 11, 12, "", 11, 11, 12, "", 13, 13, 15, "", _
16, 16, "", 16)
y = Array(4, 2.5, 2.5, 3, "", 3.5, 3.5, 2.5, 2.5, 3.5, _
"", 3.5, 3, 3.5, "", 2.5, 3, "", 3.5, 3.5, 3, 3, "", 3, _
2.5, 2.5, "", 3.5, 2.5, 2.5, 3.5, "", 3.5, 3, 3.5, "", _
2.5, 3, 2.5, "", 0.5, 1.5, 0.5, 1.5, "", 0.5, 1.5, 1.5, _
0.5, 0.5, "", 1.5, 1.5, 1, 1, "", 1, 0.5, 0.5, "", 1.5, _
0.5, 0.5, "", 1.5, 0.75, "", 0.5)
For i = 0 To 67
Cells(i + 1, 1) = x(i)
Cells(i + 1, 2) = y(i)
Next i
ici = ActiveSheet.Name
Charts.Add
With ActiveChart
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=Sheets(ici).Range("a1:b68"), _
PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, Name:=ici
End With
With ActiveChart.SeriesCollection(1).Border
.ColorIndex = 3
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With ActiveChart.SeriesCollection(1).Points(68)
.MarkerBackgroundColorIndex = 3
.MarkerForegroundColorIndex = 3
.MarkerStyle = xlCircle
.MarkerSize = 5
End With
With ActiveChart
.Axes(xlValue).MajorGridlines.Delete
.Axes(xlCategory).Delete
.Axes(xlValue).Delete
.Legend.Delete
End With
With ActiveChart.PlotArea
.Fill.PresetTextured PresetTexture:=msoTextureParchment
.Fill.Visible = True
End With
ActiveWindow.Visible = False
ActiveWindow.Activate
ActiveWindow.DisplayGridlines = False
Range("a1").Select
End Sub

;-)))
Serge