VBA: Copie d'un Spacechart à un autre

Question

Bonjour,

J'ai 2 SpaceChart dans mon code, Spacechart1 déjà créé dans Userform1 et SpaceChart2 encore vierge (dans Userform2). Je souhaite copier tout le contenu, les séries, mises en forme,... du premier SpaceChart vers le second, quelqu'un aurait-il une idée svp?


Le code, pour plus de précision...


'*****Création 1er SpaceChart*****
Public Cht1 As ChChart
Public C1

Private Sub UserForm_Initialize() '************initialize********************************
    Dim i As Integer, x As Integer
    Dim j As Integer
    Dim Tableau(10), Plage(10)
    
  
    Set C1 = ChartSpace1.Constants
    'Ajoute le graphique 1
    Set Cht1 = ChartSpace1.Charts.Add
        
'suppression des séries existantes dans le ChartSpace******************
    For i = Cht1.SeriesCollection.Count To 1 Step -1
        Cht1.SeriesCollection.Delete i - 1
    Next i
    
'Définit les abscisses(plage de cellules A1:G1)*****************
    For i = 0 To 6
        Tableau(i) = Cells(1, 1 + i)
    Next i
    
    
    '***********************************************************
    With Cht1
        'Permet l'affichage des légendes
        .HasLegend = True
        'Affiche les légendes sous le graphique
        .Legend.Position = chLegendPositionBottom
        'Attribue un titre
        .HasTitle = True
        .Title.Caption = "Mon graphique 2D"
    End With
    
'Définit le type de graphique***********************************
    '2D
    'histogramme en barre
    Cht1.Type = C1.chChartTypeBarClustered
    'histogramme en colonne
        
    'Création graphique*********************************************
        For j = 2 To 11
            '************CHT1***************************************
                    'Création de la 1ere série
            If Cht1.SeriesCollection.Count > 0 Then Cht1.SeriesCollection.Add
            'Récupération des ordonnées pour chaque série
            For i = 1 To 7
                Plage(i) = Cells(j, i)
            Next i
            With Cht1
                'Ajoute le tableau d'abscisses
                .SetData C1.chDimCategories, C1.chDataLiteral, Tableau
                'Ajoute la légenge pour chaque serie
                .SeriesCollection(x).Caption = Cells(j, 8)
                'Affiche valeur de chaque point
                .SeriesCollection(x).DataLabelsCollection.Add
                'Définit la position des valeurs affichées (au dessus par défaut)
                    'Dans la barre pour cet exemple
                .SeriesCollection(x).DataLabelsCollection(0).Position = chLabelPositionCenter
                'Les valeurs de l'histogramme seront affichées en couleur blanche.
                .SeriesCollection(x).DataLabelsCollection(0).Font.Color = RGB(255, 255, 255)
                'Ajoute le tableau d'ordonnées ( Plage() )
                .SeriesCollection(x).SetData C1.chDimValues, C1.chDataLiteral, Plage
                'Définit la couleur de la série
                .SeriesCollection(x).Interior.Color = 50000 * (j + 1)
            End With
            

            '************SUITE**************************************
            
            
            x = x + 1
            'Efface le contenu du tableau
            Erase Plage
        Next j

End Sub





Je souhaiterais faire quelquechose comme ( dans une autre UserForm):




Public chtemp As ChChart
Public ctemp


Private Sub UserForm_Initialize()
    Dim i As Integer
    
    Set ctemp = ChartSpace1.Constants
    'Ajoute le graphique 1
    Set chtemp = ChartSpace1.Charts.Add
   
    For i = 0 to UserForm1.Cht1.SeriesCollection.Count -1
          chtemp.SeriesCollection i =  UserForm1.Cht1.SeriesCollection i
End Sub

Galgante · Answer

Re,

En attendant une solution, j'ai exporté mon graphique dans une image, puis, à la place du 2nd SpaceChart, j'ai mis une image. Voici le code:


Private Sub btnFocus_Click() '******************************************FOCUS*******************************
    Dim Gr As ChartSpace
    Dim Largeur As Long, Hauteur As Long
    Dim ok As Boolean
    
    nomImage = "C:\grapheTemporaire.gif"
    Largeur = 978
    Hauteur = 570
    
    'export du chartSpace au format image Gif
    ok = False
    Do
    Select Case InputBox("Entrez le numéro, de 1 à 3 du graphique sur lequel effectuer le focus: ")
    Case 1
        Set Gr = Me.ChartSpace1
        ok = True
    Case 2
        Set Gr = Me.ChartSpace2
        ok = True
    Case 3
        Set Gr = Me.ChartSpace3
        ok = True
    Case Else
        MsgBox ("Recommencez la sélection")
    End Select
    Loop While (ok = False)
    
    Application.ScreenUpdating = False
    Gr.ExportPicture nomImage, "gif", Largeur, Hauteur
    Application.ScreenUpdating = True
    UserForm1.Hide
    UserFormTest.Show
End Sub


Et dans l'init de la 2nd form:


Private Sub UserForm_Initialize()
    Image1.Picture = LoadPicture(nomImage)
End Sub


Cdlt.

VBA: Copie d'un Spacechart à un autre

1 réponse

Discussions similaires

Newsletters