Exporter graphique dans nouveau classeur

[ikarim]

Bonjour,

ce que j'aimerais faire c'est exporter (en copier coller) des graphiques d'un classeur excel dans un AUTRE classeur qui existe déja.
Ce que j'arrive a faire c'est exporter ces graphes mais en fichier .gif (mais ca ne m'intéresse pas)

Merci!!!

[criscris11]

Bonjour Ikarim,
Chez moi pas de problème : clic droit sur le graph, copier et coller dans un autre classeur.
Reviens nous dire si ce n'est pas ça que tu cherches à faire.
Bonne journée.

[ikarim]

désolé j'ai oublié de dire que j'aimerais l'automatiser et donc l'avoir en VBA.

[criscris11]

Re,
Pourrais-tu être plus précis : est-ce toujours le même graph à copier dans le même classeur ou cela varie t'il ?

[ikarim]

j'aurais normalement 2 graphes dans un onglet. Et le document excel dans lequel se trouvent ces fichiers va changer régulièrement (a peut près toutes les semaines), mais ils auront la même forme (seule les valeurs changeront).

[criscris11]

Re,
Voici un début de code à adapter à tes besoins :

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 12/07/2008 par LSD
'

'
    ActiveSheet.DrawingObjects.Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
End Sub

Dis-nous ce que tu en penses.

[criscris11]

Pour l'instant, le code copie les objets dans un nouveau classeur. Reste à savoir si quand tu vas lancer la macro, est ce que le classeur de destination est déjà ouvert ou pas et où il se situe (en espérant qu'il soit toujours au même endroit).
Tiens-moi courant.

[ikarim]

en fait je veux que la macro soit le classeur ou je souhaite importer les graphes. est ce que je peux faire ce collage sans ouvrir le premier classeur ou se situent les graphes en question. et quelle serait la méthode?
Merci.

[criscris11]

Re,
Le code à est à mettre dans le classeur de destination (dans mon exemple classeur2).
Attention à mettre le bon chemin du classeur1 (toujours dans mon exemple) : j'ai travaillé à partir du bureau.
Testes et dis-moi.

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 12/07/2008 par LSD
'

'
    ChDir "C:\Documents and Settings\christophe\Bureau"
    Workbooks.Open Filename:= _
        "C:\Documents and Settings\christophe\Bureau\classeur1.xls"
    ActiveSheet.DrawingObjects.Select
    Selection.Copy
    Windows("classeur2.xls").Activate
    ActiveSheet.Paste
    Windows("classeur1.xls").Activate
    ActiveWindow.Close
End Sub

[ikarim]

merci ca marche. mais maintenant je dois récupérer le nom des graphes collés dans le nouveau classeur excel pour pouvoir les modifier.

[criscris11]

Re,
Je ne comprends pas très bien pourquoi tu as besoin de renommer les graphiques afin de pouvoir les modifier : pourrais-tu être un peu plus précis ?
En attendant, bonne soirée.

[Staple1600]

Bonsoir

EDITION : j'ai un doute, tu veux pouvoir modifier les graphiques dans le nouveau classeur?

Le classeur Book1.xls contient un graphique sur la feuille1.
Le classeur Book2.xls contient les données pour le graphique dans la même plage de cellules en feuille 1

Sub x() 
     
    Dim objFromChart  As ChartObject 
    Dim wbkFrom As Workbook 
    Dim shtFrom As  Worksheet 
    Dim wbkTo As Workbook 
    Dim shtTo As Worksheet 
    Dim intIndex As Integer 
    Dim objToChart As ChartObject 
     
    Set wbkFrom = Workbooks("Book1.xls") 
    Set shtFrom = wbkFrom.Worksheets("Sheet1") 
    Set wbkTo = Workbooks("Book2.xls") 
    Set shtTo = wbkTo.Worksheets("Sheet1") 
     
    Set objFromChart = shtFrom.ChartObjects(1) 
     
    objFromChart.Copy 
    shtTo.Paste shtTo. Range("D5") 
    Set objToChart = shtTo.ChartObjects(shtTo.ChartObjects.Count) 
     
    For intIndex = 1 To objToChart.Chart.SeriesCollection.Count 
        objToChart.Chart.SeriesCollection(intIndex).Formula = _ 
        Replace(objToChart.Chart.SeriesCollection(intIndex).Formula, _ 
        wbkFrom.Name, wbkTo.Name) 
    Next 
End Sub

Une macro qui copie les graphiques comme des images
dans un nouveau classeur créé pour l'occasion

Sub CopyChart()
'source
'
Dim ChartBook As Workbook, SourceBook As Workbook
Dim TmpSheets As Integer, wkSheet As Worksheet
Dim ChartObj, ChartCount As Long

Set SourceBook = ActiveWorkbook

For Each wkSheet In SourceBook.Sheets
If wkSheet.ChartObjects.Count > 0 Then
ChartCount = ChartCount + 1
End If
Next

If ChartCount < 1 Then Exit Sub

TmpSheets = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = ChartCount
Set ChartBook = Workbooks.Add
Application.SheetsInNewWorkbook = TmpSheets
TmpSheets = 1

For Each wkSheet In SourceBook.Sheets
If wkSheet.ChartObjects.Count > 0 Then
    With ChartBook.Sheets(TmpSheets)
        .Activate
        .Name = wkSheet.Name
        wkSheet.Cells.Copy
        .Paste
        .ChartObjects.Delete
    End With
ChartCount = 1
    For Each ChartObj In wkSheet.ChartObjects
    ChartObj.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    ChartBook.Sheets(TmpSheets) _
    .PasteSpecial Format:="Picture (Enhanced Metafile)", _
    Link:=False, DisplayAsIcon:=False
        With ChartBook.Sheets(TmpSheets).Shapes(ChartCount)
            .Top = ChartObj.Top
            .Left = ChartObj.Left
        End With
    ChartCount = ChartCount + 1
    Next
TmpSheets = TmpSheets + 1
End If
Next
End Sub