Emplacement de graphique à une position précise
Bonjour à tous. J'aimerais avoir votre aide. étant novice en vba je suis en train d'effectuer un projet. Il s'avère que je coince dans une certaine partie de mon code.
MON PROBLEME:
Je souhaite copier plusieurs graphique dans des feuilles précédentes et les coller tous les un a coté de autre pour cela j'ai taper le code suivant
Dim k, u As Variant
k = 8
u = 11
For i = 4 To Worksheets.Count - 1
Worksheets(i).Select
ActiveSheet.ChartObjects("equipment").Activate
ActiveChart.ChartArea.Copy
Worksheets("Présentation").Select
ActiveSheet.Paste
With Selection ' dimension du tableau
.Left = Range(Cells(84, k), Cells(95, u)).Left
.Top = Range(Cells(84, k), Cells(95, u)).Top
.Width = Range(Cells(84, k), Cells(95, u)).Width
.Height = Range(Cells(84, k), Cells(95, u)).Height
End With
ActiveChart.SeriesCollection(1).Interior.Color = RGB(31, 73, 125)
ActiveChart.SeriesCollection(2).Interior.Color = RGB(155, 187, 89)
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(155, 187, 89)
.BackColor.ObjectThemeColor = msoThemeColorBackground1
.BackColor.TintAndShade = 0
.BackColor.Brightness = 0
.Patterned msoPattern5Percent
End With
ActiveChart.SetElement (msoElementChartTitleAboveChart)
Selection.Caption = Worksheets(i).Name
u = u + 5
k = k + 5
Next icela fonctionne pour le premier graphique. Mais avec celui de la feuille suivante j'ai cette erreur qui s'affiche malgré l'incrémentation des variables u et k.
Je ne sais pas comment parvenue a le faire fonctionner.
Merci d'avance pour votre aide
Simple piste car je n'ai pas réellement fouillé et je ne prétend en rien à être un maitre VBA
C'est pas une histoire de : Left et Top sont des positions et Width et Height sont des largeurs et hauteurs donc arguments différents ?
Bonjour,
Merci de joindre un fichier réduit au plus simple.
Cdlt.
oui bien sure pas de soucis.
Cela donnerai cela.
Les graphiques porte tous le mm nom dans des feuilles différentes
Et sur la premiere feuille je veux les aligner les un a coté des autres et le redimensionner
Merci d'avance
Bonjour,
Je te propose un exemple à étudier et à adapter suivant tes besoins.
Cdlt.
Option Explicit
Public Sub CopyCharts()
Dim wb As Workbook
Dim ws As Worksheet, wsCharts As Worksheet
Dim shp As Shape
Dim objChart As ChartObject
Dim rngChart As Range
Dim lCol As Long, lCol2 As Long
lCol = 8: lCol2 = 12
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
Set wsCharts = wb.Worksheets("Feuil1")
For Each ws In wb.Worksheets
If ws.Name <> wsCharts.Name Then
Set rngChart = Range(ws.Cells(84, lCol), ws.Cells(95, lCol2))
Set shp = ws.ChartObjects(1).Duplicate
Set objChart = shp.Chart.Parent
With objChart
.Left = rngChart.Left
.Top = rngChart.Top
.Width = rngChart.Width
.Height = rngChart.Height
.Name = ws.Name
With .Chart
.HasTitle = True
With .ChartTitle
.Characters.Text = objChart.Name
.Font.Bold = True
.Font.Size = 11
End With
.HasLegend = True
With .Legend
.Position = xlCorner
.IncludeInLayout = False
End With
.SetElement (msoElementPrimaryCategoryGridLinesMajor)
.SeriesCollection(1).Interior.Color = RGB(31, 73, 125)
.SeriesCollection(2).Interior.Color = RGB(155, 187, 89)
End With
.Chart.Location xlLocationAsObject, wsCharts.Name
End With
End If
lCol = lCol + 5: lCol2 = lCol2 + 5
Next ws
Set rngChart = Nothing
Set objChart = Nothing
Set shp = Nothing
Set wsCharts = Nothing
Set wb = Nothing
End Sub