Création graph par macro + choix d'une serie par msgbox

eleck

XLDnaute Nouveau
Bonjour à tous,

Voici un petit probleme qui m'occupe actuellement et je séche ,...
Je viens donc vous demander un petit coup de main si possible.

Mon idée est donc de créer un graphique avec 2séries avec une macro
cependant d'abord la macro demande un point de départ et un point de fin pour monter les séries.

c'est la que je calle en fait.

Sub GraphLT()
'
Dim D As Object
Dim F As Object
Dim rowD As Integer
Dim rowF As Integer

début = InputBox("Semaine de départ de la période ", "Question")
Fin = InputBox("Semaine de fin de la période", "question")

Set D = Worksheets("sheet2").Range("Ae:Ae").Find(début).Activate
rowD = ActiveCell.Row
Set F = Worksheets("sheet2").Range("Ae:Ae").Find(début).Activate
rowF = ActiveCell.Row



Range("AE1 :AE" & rowF, "ag1 :ag" & rowF).Select
Range("AG1").Activate
Charts.Add
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=Sheets("Sheet2").Range("AE1 :AE" & rowF, "ag1 :ag" & rowF) _
, PlotBy:=xlColumns
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Values = "=Sheet2!R1C59:R21C59"
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet2"
ActiveChart.HasDataTable = False

sonnom = ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Name

ActiveSheet.Shapes(sonnom).ScaleWidth 0.46, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes(sonnom).ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
ActiveSheet.ChartObjects(sonnom).Left = Range("A1").Left
ActiveSheet.ChartObjects(sonnom).Top = Range("A1").Top
ActiveChart.Legend.Select
Selection.Delete



ActiveWindow.Visible = False

Bref il reprend pas du tout le range que je veux.
Les messages box on comme reponse le numéro de la semaine et donc je veux qu'il retrouve cette valeur dans la collone attribuée. une fois la valeur trouvée je reprend la ligne de la valeur et c'est cette ligne que j'utilise comme parametre de début ou de fin de série.

Je vous remercie d'avance pour vos idées.


modif : J'ai ajouté un exemple avec le code en simplifié.
 

Pièces jointes

  • Book1.xls
    21 KB · Affichages: 99
  • Book1.xls
    21 KB · Affichages: 102
  • Book1.xls
    21 KB · Affichages: 116
Dernière édition:

PMO2

XLDnaute Accro
Re : Création graph par macro + choix d'une serie par msgbox

Bonjour,

Essayez le code suivant

Code:
'### Constante à adapter ###
Const MA_FEUILLE As String = "Sheet2"
'###########################

Sub graphLT_pmo()
Dim S As Worksheet
Dim R As Range
Dim reponse
Dim rowD As Long
Dim rowF As Long
Dim C As Chart
Dim SH As Shape

On Error Resume Next
Set S = Sheets(MA_FEUILLE)
Set R = S.Range("n1:n" & S.Range("n1").End(xlDown).Row & "")
reponse = Application.InputBox(prompt:="Semaine de départ de la période ", _
    Title:="Question", Default:=S.[n2], Type:=2)
If reponse = False Then Exit Sub
rowD = R.Find(reponse).Row
If Err <> 0 Then Exit Sub
reponse = Application.InputBox(prompt:="Semaine de fin de la période ", _
    Title:="Question", Default:=S.[n2], Type:=2)
If reponse = False Then Exit Sub
rowF = R.Find(reponse).Row
If Err <> 0 Then Exit Sub
Set R = Range("p" & rowD & ":p" & rowF, "t" & rowD & ":t" & rowF)
Set C = Charts.Add
C.ChartType = xlLineMarkers
C.SetSourceData Source:=R, PlotBy:=xlColumns
C.SeriesCollection.NewSeries
C.SeriesCollection(2).Values = "=Sheet2!R1C19:R21C19"
C.Location Where:=xlLocationAsObject, Name:=S.Name
C.HasDataTable = False
Set SH = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
SH.Left = Range("A1").Left
SH.Top = Range("A1").Top
SH.Width = 240
SH.Height = 125
S.[a1].Select
End Sub

Cordialement.

PMO
Patrick Morange
 

Statistiques des forums

Discussions
312 482
Messages
2 088 765
Membres
103 954
dernier inscrit
SirJah