1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
| Private Sub CbtOk_Click()
Dim graphe As Chart
Dim fsource As Worksheet
Dim plagedonnée As Range
Dim nom As String
Dim fin As Integer
Dim derligne As Integer
Dim i As Integer
Dim trouve As Range
Dim lgraphe As Integer
Dim plageX As Range
Dim plageY1 As Range
Dim plageY2 As Range
Dim maserie1 As Series, maserie2 As Series
'Application.ScreenUpdating = False
fin = Me.ListBox1.ListCount
Set fsource = ThisWorkbook.Worksheets("graphe")
derligne = fsource.Range("B65536").End(xlUp).Row
Set plagenom = fsource.Range(Cells(1, 2), Cells(derligne, 2))
For i = 1 To fin - 1
nom = ""
With ListBox1
If .Selected(i) = True Then nom = .List(i)
End With
If nom <> "" Then
If SheetExists(ThisWorkbook, Left(nom, 30)) Then Sheets(Left(nom, 30)).Delete
Set trouve = plagenom.Find(nom, plagenom.Cells(1), xlValues, xlWhole, xlByColumns, xlNext)
lgraphe = trouve.Row
coldroite = fsource.Cells(lgraphe + 1, 100).End(xlToLeft).Column
Set maplage = Range(Cells(lgraphe, 2), Cells(lgraphe + 6, coldroite))
Set graphe = ThisWorkbook.Charts.Add 'After:=thisworkbook.Worksheets("graphe")
ActiveSheet.Name = Left(nom, 30)
graphe.ChartArea.clear
graphe.ChartType = xlXYScatterLines
Set plageX = maplage.Rows(4) 'fsource.Range(Cells(lgraphe + 3, 2), Cells(lgraphe + 3, coldroite))
Set plageY1 = maplage.Rows(6) 'fsource.Range(Cells(lgraphe + 5, 2), Cells(lgraphe + 5, coldroite))
Set plageY2 = maplage.Rows(7) 'fsource.Range(Cells(lgraphe + 6, 2), Cells(lgraphe + 6, coldroite))
Set maserie1 = graphe.SeriesCollection.NewSeries
With maserie1
.Values = plageY1
.XValues = plageX
.Name = fsource.Cells(lgraphe + 5, 1).Value
End With
Set maserie2 = graphe.SeriesCollection.NewSeries
With maserie2
.Values = plageY2
.XValues = plageX
.Name = fsource.Cells(lgraphe + 6, 1).Value
End With
End If
fsource.Select
Next i
UserForm1.Hide
Unload UserForm1
Application.ScreenUpdating = True |
Partager