Vba, classeur actif

Version imprimable

Vba, classeur actif

Bonjour, débutant en orienté objet je cherche depuis un petit moment a faire une macro qui crée plusieurs graphique dans un nouveau classeur sur une même feuille, j'ai un code qui marche un peu prés si aprés chaque entrée de plage on retourne sur le classeur ou on veut les graphiques.
voila le code:

Code:

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
68
69
70
71
72
73
74
75
76
77
78
79
Sub encorunemacro() 
Dim plage As Range 
compt = 1 
 
' creer classeur et nommé la feuille 
Set nouv = Workbooks.Add 
Sheets("Feuil1").Name = "Graphique" 
ActiveWorkbook.SaveAs Filename:="Graphique.xls" 
 
' classeur actif et non classeur graphique 
For compt = 1 To 3 
Sheets("Graphique").Select 
Set plage = Application.InputBox(prompt:="plage", Type:=8) 
Charts.Add 
    ActiveChart.ChartType = xlLine 
    ActiveChart.SetSourceData Source:=plage 
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Graphique" 
    With ActiveChart 
        .HasTitle = False 
        .Axes(xlCategory, xlPrimary).HasTitle = False 
        .Axes(xlValue, xlPrimary).HasTitle = False 
    End With 
Next 
 
' positionner les graphiques
With Sheets(1) 
    .Shapes("Chart 1").Left = 0 
    .Shapes("Chart 1").Top = 0 
    .Shapes("Chart 2").Top = 0 
    .Shapes("Chart 2").Left = .Shapes("Chart 1").Width + 5 
    .Shapes("Chart 3").Top = 0 
    .Shapes("Chart 3").Left = .Shapes("Chart 2").Width + 370 
End With 
End Sub 
 
Je pense que cela vient du fait que le graphique ce crée sur le classeur actif (traitement.xls), mais je n'arrive pas a lui dire de le faire sur le classeur ("graphique.xls")
Pour cela j'ai essayé en autre des choses de ce type:
 
Sub encorunemacro()
Dim plage As Range
Dim cible As String
Dim wb As Workbook
Dim ws As Worksheet
 
compt = 1
 
' creer classeur et nommé la feuille
Set nouv = Workbooks.Add
Sheets("Feuil1").Name = "Graphique"
ActiveWorkbook.SaveAs Filename:="Graphique.xls"
 
' classeur actif et non classeur graphique
Set wb = Workbooks("Graphique.xls")
Set ws = Worksheets("Graphique")
 
For compt = 1 To 3
Sheets("Graphique").Select
Set plage = Application.InputBox(prompt:="plage", Type:=8)
wb.ws.Charts.Add
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=plage
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Graphique"
    With ActiveChart
        .HasTitle = False
        .Axes(xlCategory, xlPrimary).HasTitle = False
        .Axes(xlValue, xlPrimary).HasTitle = False
    End With
Next
 
'
With Sheets(1)
    .Shapes("Chart 1").Left = 0
    .Shapes("Chart 1").Top = 0
    .Shapes("Chart 2").Top = 0
    .Shapes("Chart 2").Left = .Shapes("Chart 1").Width + 5
    .Shapes("Chart 3").Top = 0
    .Shapes("Chart 3").Left = .Shapes("Chart 2").Width + 370
End With
End Sub

qui ne fonctionne malheureusement pas.
Je suis a l'écoute de toute proposition, Merci beaucoup.
Cordialement Zanzib.

Bonjour Zanzib, bonjour le forum,

Dans ce genre de cas j'utilise des variables pour les classeurs et onglets du style :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Sub Macro1() Dim CS As Workbook 'déclare la variable CS (Classeur Source) Dim OS As Worksheet 'déclare la variable CO (Onglet Source) Dim CD As Workbook 'déclare la variable CD (Classeur Destination) Dim OD As Worksheet 'déclare la variable OD (Onglet Destination) Set CS = ThisWorkbook Set OS = CS.Sheets("Graphique") Workbooks.Add Set CD = ActiveWorkbook Set OD=CD.Sheets(1) OD.Name = "Graphique" CD.SaveAs Filename:="Graphique.xls" End Sub
Puis je supprime tous les Select inutiles en utilisant : With OS... End With / OS.range(PlageSource).Copy OD.Range(celluleDstination)

[Édition]
J'ai corrigé les erreurs et défini l'onglet OD...

28/08/2015, 12h28
Quentin77170

Salut à toi,

Peux-tu, dans un premier temps, baliser ton code avec [ CODE]ton code[ /CODE] (sans les espaces) ou en utilisant le bouton "#" dans l'éditeur de messages ?

Je n'ai pas le temps maintenant de répondre vraiment, mais par contre je trouve que tu n'utilises presque pas de variables objets, ce qui est vraiment dommage...
28/08/2015, 13h47
zanzib

Merci

Marche parfaitement, sait-tu si on peut améliorer la macro en laissant le classeur source au premier plan?
Sinon merci beaucoup et bonne journée.
28/08/2015, 17h18
Thautheme

Re,

Il te suffit de rajouter dans le code la ligne : CS.Activate (après avoir défini CS bien sûr) et si tu te balades entre les classeurs voire même entre les onglets je te recommande :
Application.ScreenUpdating = False en début de code et Application.ScreenUpdating = True en fin de code...

Bonjour,
J'arrive trop tard mais pour le plaisir!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub test()
 
Dim grph As New clsGraphe
grph.Delete Sheets("Feuil2"), "Grp"
grph.Nouveau Sheets("Feuil2"), "Grp"
grph.Graphique_Source ActiveSheet.UsedRange
grph.Graphique_Style ExlPieExploded
grph.Graphique_NewSeries ActiveSheet.Range("E1")
grph.Graphique_NewSeries_String "=Feuil1!$B$3,Feuil1!$D$3,Feuil1!$F$3,Feuil1!$H$3,Feuil1!$J$3,Feuil1!$L$3"
grph.Graphique_NewSeries_String "=Feuil1!$C$3,Feuil1!$E$3,Feuil1!$G$3,Feuil1!$I$3,Feuil1!$K$3,Feuil1!$M$3"
grph.Graphique_SeriesCollection
grph.Graphique_Taille 200, 300
grph.Graphique_Position 50, 100
grph.SaveAs_Image Sheets("Feuil2"), "Grp", "C:\Users\Robert\Desktop\Grah.jpg"
End Sub

Code:

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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
Dim Shap As Shape
Enum style
    ExlColumnClustered = xlColumnClustered
    ExlColumnStacked = xlColumnStacked
    ExlColumnStacked100 = xlColumnStacked100
    Exl3DColumnClustered = xl3DColumnClustered
    Exl3DColumnStacked = xl3DColumnStacked
    Exl3DColumnStacked100 = xl3DColumnStacked100
    Exl3DColumn = xl3DColumn
    ExlCylinderColClustered = xlCylinderColClustered
    ExlCylinderColStacked = xlCylinderColStacked
    ExlCylinderColStacked100 = xlCylinderColStacked100
    ExlCylinderCol = xlCylinderCol
    ExlConeColClustered = xlConeColClustered
    ExlConeColStacked = xlConeColStacked
    ExlConeColStacked100 = xlConeColStacked100
    ExlConeCol = xlConeCol
    ExlPyramidColClustered = xlPyramidColClustered
    ExlPyramidColStacked = xlPyramidColStacked
    ExlPyramidColStacked100 = xlPyramidColStacked100
    ExlPyramidCol = xlPyramidCol
    ExlLine = xlLine
    ExlLineStacked = xlLineStacked
    ExlLineStacked100 = xlLineStacked100
    ExlLineMarkers = xlLineMarkers
    ExlLineMarkersStacked = xlLineMarkersStacked
    ExlLineMarkersStacked100 = xlLineMarkersStacked100
    Exl3DLine = xl3DLine
    ExlPie = xlPie
    ExlPieExploded = xlPieExploded
    ExlPieOfPie = xlPieOfPie
    ExlBarOfPie = xlBarOfPie
    Exl3DPie = xl3DPie
    Exl3DPieExplodede = xl3DPieExploded
    ExlBarClustered = xlBarClustered
    ExlBarStacked = xlBarStacked
    ExlBarStacked100 = xlBarStacked100
    Exl3DBarClustered = xl3DBarClustered
    Exl3DBarStacked = xl3DBarStacked
    Exl3DBarStacked100 = xl3DBarStacked100
    ExlCylinderBarClustered = xlCylinderBarClustered
    ExlCylinderBarStacked = xlCylinderBarStacked
    ExlCylinderBarStacked100 = xlCylinderBarStacked100
    ExlConeBarClustered = xlConeBarClustered
    ExlConeBarStacked = xlConeBarStacked
    ExlConeBarStacked100 = xlConeBarStacked100
    ExlPyramidBarClustered = xlPyramidBarClustered
    ExlPyramidBarStacked = xlPyramidBarStacked
    ExlPyramidBarStacked100 = xlPyramidBarStacked100
    ExlArea = xlArea
    ExlAreaStacked = xlAreaStacked
    ExlAreaStacked100 = xlAreaStacked100
    Exl3DArea = xl3DArea
    Exl3DAreaStacked = xl3DAreaStacked
    Exl3DAreaStacked100 = xl3DAreaStacked100
    ExlXYScatter = xlXYScatter
    ExlXYScatterSmooth = xlXYScatterSmooth
    ExlXYScatterSmoothNoMarkers = xlXYScatterSmoothNoMarkers
    ExlXYScatterLines = xlXYScatterLines
    ExlXYScatterLinesNoMarkers = xlXYScatterLinesNoMarkers
    ExlDoughnut = xlDoughnut
    ExlDoughnutExploded = xlDoughnutExploded
    ExlBubble = xlBubble
    ExlBubble3DEffect = xlBubble3DEffect
    ExlRadar = xlRadar
    ExlRadarMarkers = xlRadarMarkers
    ExlRadarFilled = xlRadarFilled
    ExlSurface = xlSurface
    ExlSurfaceWireframe = xlSurfaceWireframe
    ExlSurfaceTopView = xlSurfaceTopView
    ExlSurfaceTopViewWireframe = xlSurfaceTopViewWireframe
End Enum
 
Public Sub Graphique_New(Feuille As Worksheet)
Set Shap = Feuille.Shapes.AddChart
End Sub
Public Sub Graphique_Source(Myrange As Range)
 Shap.Chart.SetSourceData Myrange
End Sub
Public Sub Graphique_Style(MyStyle As style)
 Shap.Chart.ChartType = MyStyle
End Sub
Public Sub Graphique_NewSeries(Myrange As Range)
 Shap.Chart.SeriesCollection.NewSeries.Values = Myrange
End Sub
Public Sub Graphique_NewSeries_String(Page As String)
 Shap.Chart.SeriesCollection.NewSeries.Values = Page
End Sub
Public Sub Graphique_SeriesCollection()
 
 Shap.Chart.SeriesCollection(1).ApplyDataLabels
End Sub
 
Public Sub Graphique_Taille(Hauteur As Integer, Largeur As Integer)
 Shap.Height = Hauteur
 Shap.Width = Largeur
End Sub
Public Sub Graphique_Position(X As Integer, Y As Integer)
 Shap.Top = X
 Shap.Left = Y
End Sub
Public Sub SaveAs_Image(Feuille As Worksheet, Non As String, fichier As String)
For Each MyObject In Feuille.Shapes
    If MyObject.Name = Non Then
        MyObject.Chart.Export Filename:=fichier, FilterName:="GIF"
        Exit Sub
    End If
Next
End Sub
Public Sub Delete(Feuille As Worksheet, Non As String)
For Each MyObject In Feuille.Shapes
    If MyObject.Name = Non Then MyObject.Delete: Exit Sub
Next
End Sub
Public Sub Nouveau(Feuille As Worksheet, Non As String)
Set Shap = Feuille.Shapes.AddChart
Shap.Name = Non
End Sub

29/08/2015, 00h46
Thautheme

Bonsoir,

Tu n'arrives jamais trop tard...
31/08/2015, 09h31
zanzib

Merci a la communauté, bonne journée a tous