PRob lème avec le Set Source Data

Le 16/08/2018 à 07:10

Bonjour,

N'ayant pas trouvé solution à mon problème ailleurs sur le net, je viens en dernier espoir demander de l'aide sur ce forum.

J4ai du créer des programmes sous vba pour assister mes documents office et leur mise à jour. A ce titre je dois manipuler des graphiques et leur donner une source.

Mon problème est le suivant : Tout fonctionne seulement lorsque je souhaite associer la source, on me retourne une erreur 1004 (erreur définie par l'application ou par l'objet).

Voici le morceau-type concerné : [Graphique].SetSourceData Source:=XlBookC.Sheets(3).Range(cell_debut, cell_fin)

Après de multiples tentatives, rien à faire, le problème est le même.

Merci pour votre aide 

     

Option Explicit
Sub ProductionGraphes()

Dim XlApp, PptApp As Object
Dim XlBook2, XlBookC, Pres As Object
Dim MoisSave, JourSave As Integer              'jour / mois pour la sauvegarde
Dim AnneePrec, MoisPrec As Integer             'an / mois précédents la mise à jour

Dim EfficienceIBM_T As Chart
Dim EfficienceIBM_UN, EfficienceIBM_NO, EfficienceIBM_ZO  As Chart
Dim EffMachines As Variant
Dim EfficienceIBM_140, EfficienceIBM_200, EfficienceIBM_300, EfficienceIBM_400 As Chart
Dim EfficienceIBM_500, EfficienceIBM_600, EfficienceIBM_700, EfficienceIBM_800 As Chart
Dim EfficienceIBM_900, EfficienceIBM_1000, EfficienceIBM_1100 As Chart

Dim CompteurEff As Chart
Dim Efficience As Double

Dim sld As Slide

Dim Semaine As Integer
Dim cell_debut, cell_fin As Variant

Dim cpt, gr, i As Integer     ' compteur pour / et derniere forme de la diapo
'_______________________________________________________
'_______________________________________________________

'Repérage du mois précédent pour l'appel du fichier ensuite
'+repérage de la limite pour supprimer les anciens fichier
If Month(Date) = 1 Then
    MoisPrec = 12
    AnneePrec = Year(Date) - 1
Else
    MoisPrec = Month(Date) - 1
    AnneePrec = Year(Date)
End If
'________________________________________________________

'ouverture des documents + détéction nécessité màj
Set XlApp = CreateObject("Excel.Application")
XlApp.Visible = False
Set PptApp = CreateObject("Powerpoint.Application")
PptApp.Visible = True

Set XlBook2 = XlApp.Workbooks.Open(CheminX2 & "TPM IBM 2018-  WIP.xlsm")
Set XlBookC = XlApp.Workbooks.Open(CheminXC & "Graphiques_qualité_export.xlsx")
If MoisPrec < 10 Then
    Set Pres = PptApp.Presentations.Open(CheminP & Nom & ".pptm")
Else
    Set Pres = PptApp.Presentations.Open(CheminP & Nom & ".pptm")

End If
'__________________________________________________________

'Suppression des anciens graphiques existants afin d'en créer de nouveaux après
For cpt = 7 To 11         'gr=référence de l'objet graphique
    With Pres.Slides(cpt)
    Pres.Slides(cpt).Shapes(Pres.Slides(cpt).Shapes.Count).Delete
        If cpt = 8 Or cpt = 9 Then
            For gr = 1 To 2
                Pres.Slides(cpt).Shapes(Pres.Slides(cpt).Shapes.Count - gr).Delete
            Next
            If cpt = 9 Then
                For gr = 3 To 5
                    Pres.Slides(cpt).Shapes(Pres.Slides(cpt).Shapes.Count - gr).Delete
                Next
            End If
        End If
    End With
Next
'//////////////////////////////////////////////////////////////////////////

'Création de la forme graphique 1 dansla slide 7
Set EfficienceIBM_T = Pres.Slides(7).Shapes.AddChart2.Chart

EfficienceIBM_T.ChartType = xlDoughnut
EfficienceIBM_T.ChartStyle = 18
With Pres.Slides(7).Shapes(Pres.Slides(7).Shapes.Count)
    .Left = 17
    .Top = 75
    .Width = 668.6
    .Height = 331
    .Chart.SeriesCollection(3).Delete
    .Chart.SeriesCollection(2).Delete
End With

'//////////////////////////////////////////////////////////////////////////
'Création des forme graphique 1,2 et 3 dansla slide 8
Set EfficienceIBM_UN = Pres.Slides(8).Shapes.AddChart2.Chart
Set EfficienceIBM_NO = Pres.Slides(8).Shapes.AddChart2.Chart
Set EfficienceIBM_ZO = Pres.Slides(8).Shapes.AddChart2.Chart

EfficienceIBM_UN.ChartType = xlDoughnut
EfficienceIBM_UN.ChartStyle = 18
EfficienceIBM_NO.ChartType = xlDoughnut
EfficienceIBM_NO.ChartStyle = 18
EfficienceIBM_ZO.ChartType = xlDoughnut
EfficienceIBM_ZO.ChartStyle = 18

For i = Pres.Slides(8).Shapes.Count - 2 To Pres.Slides(8).Shapes.Count
    With Pres.Slides(8).Shapes(i)
        .Chart.SeriesCollection(3).Delete
        .Chart.SeriesCollection(2).Delete
        .Width = 260
        .Height = 205.14
        .Top = 147.7143
        If i = Pres.Slides(8).Shapes.Count - 2 Then
            .Left = 79.1429
        ElseIf i = Pres.Slides(8).Shapes.Count - 1 Then
            .Left = 312.2857
        ElseIf i = Pres.Slides(8).Shapes.Count Then
            .Left = 545.7143

        End If
        .ZOrder msoSendToBack
    End With
Next
'//////////////////////////////////////////////////////////////////////////

'Création des forme graphique 1, 2, 3, 4, 5 et 6 dansla slide 9 ; 1, 2, 3, 4 et 5 dans la slide 10
EffMachines = Array(EfficienceIBM_140, EfficienceIBM_200, EfficienceIBM_300, EfficienceIBM_400, EfficienceIBM_500, EfficienceIBM_600, EfficienceIBM_700, EfficienceIBM_800, EfficienceIBM_900, EfficienceIBM_1000, EfficienceIBM_1100)
For i = 0 To 5
    Set EffMachines(i) = Pres.Slides(9).Shapes.AddChart2.Chart
    EffMachines(i).ChartType = xlDoughnut
    EffMachines(i).ChartStyle = 18
    Set EffMachines(i + 5) = Pres.Slides(10).Shapes.AddChart2.Chart
    EffMachines(i + 5).ChartType = xlDoughnut
    EffMachines(i + 5).ChartStyle = 18
    For cpt = 9 To 10
        With Pres.Slides(cpt).Shapes(Pres.Slides(9).Shapes.Count)
            .Chart.SeriesCollection(3).Delete
            .Chart.SeriesCollection(2).Delete
            .Chart.SeriesCollection(1).Border.ColorIndex = IIf(i, xlAutomatic, xlNone)
            .Width = 332.286
            .Height = 194.28
            If i = 0 Or i = 1 Or i = 2 Then
                .Top = 110.57
            Else
                .Top = 253.429
            End If

            If i = 0 Or i = 3 Then
                .Left = 61.4285
            ElseIf i = 1 Or i = 4 Then
                .Left = 239.1428
            Else
            .Left = 426.857
            End If
            .ZOrder msoSendToBack
        End With
    Next
Next

'Positionnement des légendes
Pres.Slides(8).Shapes(Pres.Slides(8).Shapes.Count - 3).ZOrder msoBringToFront
Pres.Slides(9).Shapes(Pres.Slides(9).Shapes.Count - 6).ZOrder msoBringToFront
For cpt = 4 To 9
    If cpt = 4 Or 5 Or 6 Then
        Pres.Slides(9).Shapes(Pres.Slides(9).Shapes.Count - cpt).ZOrder 1
    End If
    ''Pres.Slides(11).Shapes(Pres.Slides(11).Shapes.Count - cpt).ZOrder 1
Next
'//////////////////////////////////////////////////////////////////////////

'Mise en forme des différents graphiques

''''For cpt = 7 To 9
    ''''Pres.Slides(cpt).TimeLine.MainSequence.AddEffect Shape:=sld.Shapes(Pres.Slides(cpt).Count), effectId:=msoAnimEffectWheel
    ''''If cpt <> 7 Then
        ''''Pres.Slides(cpt).TimeLine.MainSequence.AddEffect Shape:=sld.Shapes(Pres.Slides(cpt).Count - 1), effectId:=msoAnimEffectWheel, Level:=msoAnimateChartByCategory
        ''''Pres.Slides(cpt).TimeLine.MainSequence.AddEffect Shape:=sld.Shapes(Pres.Slides(cpt).Count - 2), effectId:=msoAnimEffectWheel, Level:=msoAnimateChartByCategory
        ''''If cpt <> 8 Then
            ''''For i = Pres.Slides(cpt).Count - 5 To Pres.Slides(cpt).Count - 3
                ''''Pres.Slides(cpt).TimeLine.MainSequence.AddEffect Shape:=sld.Shapes(i), effectId:=msoAnimEffectWheel, Level:=msoAnimateChartByCategory
            ''''Next
        ''''End If
    ''''End If
''''Next

'Création des forme graphique compteur dansla slide 11
Set CompteurEff = Pres.Slides(11).Shapes.AddChart2.Chart

'Mise à jour des données du compteur dans l'excel
Efficience = XlBook2.Sheets("All data daily").Cells(6, 4).Value
XlBookC.Sheets("compteur").Cells(2, 3).Value = Efficience     'valeur que doit pointer l'aiguille
XlBookC.Sheets("compteur").Cells(4, 3).Value = 100 - Efficience - 1  '1 est l'épaisseur de l'aiguille

CompteurEff.ChartType = xlDoughnut
CompteurEff.ChartStyle = 18
With Pres.Slides(11).Shapes(Pres.Slides(11).Shapes.Count)
    .Left = 17
    .Top = 75
    .Width = 668.6
    .Height = 331
    .Chart.SeriesCollection(3).Delete
    .Chart.SeriesCollection(2).Format.Line.ForeColor.RGB = RGB(239, 239, 239)

    cell_debut = XlBookC.Sheets(3).Cells(1, 1)
    cell_fin = XlBookC.Sheets(3).Cells(5, 3)

    ''''Chart.SeriesCollection(1).XValues = XlBookC.Sheets(3).Range(cell_debut, cell_fin)
    .Chart.SetSourceData Source:=XlBookC.Sheets(3).Range(cell_debut, cell_fin)
End With
'____________________________________________________________________________

'Attribution des données
Semaine = Format(Date, "WW") - 4
For i = 7 To 11
    If i = 7 Then

    ElseIf i = 8 Then

    [size=200]Pres.Slides(i).Shapes(Pres.Slides(i).Shapes.Count).Chart.SetSourceData Source:=XlBookC.Sheets(3).Range(cell_debut, cell_fin)[/size]
    End If
Next
'Fin de la procédure
MsgBox "Mise à jour effectuée avec succès"

XlBook2.Close SaveChanges:=False
XlApp.Quit

End Sub
Le 16/08/2018 à 08:03

bonjour

depuis 10 ans, on récupère des données de multiples sources avec Menu Données Obtenir

ceci permet par exemple, de récupérer des milliers de fichiers de données, de les digérer et de tracer des courbes interactives (tu mets des segments pour afficher telle ou telle source, telle ou telle annnée, tel ou tel client etc.

pas de VBA.

essaye

si problème, joins 2 fichiers source exemple et un 1 graphique

Rechercher des sujets similaires à "prob leme set source data"