[XL-2007] Suite : exporter des fuilles graphiques [Résolu]

[Arapaima]

Bonjour à tous,
Le but de la macro est d'exporter les graphiques d'un classeur C1 dans un nouveau classeur C2 en coupant les liens.
Je procède par collage spécial en métafichier amélioré.

Tout va bien jusqu'à la ligne 26 ouj'ai un problème sur la méthode pastespécial obtenu avec l'enregistreur de macro : La méthode PastSpecial de la classe worksheet a échoué.

Je ne comprend pas d'où vient cette erreur
Est-il possible de procéder de cette manière, ou est-il existe-t-il une autre méthode plus "conventionnelle" pour couper les liens d'un graphique?

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
 
Public Sub exporterGraphiques()
Dim c1                        As Workbook
Dim c2                        As Workbook
Dim sh                        As Chart
 
Dim compteur
 
Set c1 = ThisWorkbook
 Workbooks.Add 1
    Set c2 = ActiveWorkbook
 
    c1.Activate
    compteur = 0
    For Each sh In Charts
    compteur = compteur + 1
    c2.Activate
    Sheets.Add before:=Sheets(1)
    ActiveSheet.Name = "Graph" & compteur
    c1.Activate
    sh.Activate
    If Left(sh.Name, 5) = "Graph" Then
    ActiveChart.ChartArea.Copy
    c2.Sheets(1).Activate
    Range("a1").Select
    ActiveSheet.PasteSpecial Format:="Image (métafichier amélioré)", Link:=False, DisplayAsIcon:=False
 
     End If
     Next
 
 
End Sub

Merci pour votre aide

[ZebreLoup]

Bonjour voici un code qui devrait marcher. C'est surtout je pense au niveau de la copie qu'il y avait un problème.
J'en profite pour te signaler de te méfier un peu de l'enregistreur de macro, c'est bien pour trouver des fonctions que tu ne connais pas, mais ensuite, il vaut mieux réécrire le code plus proprement en évitant des select dans tous les sens.

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
Public Sub exporterGraphiques()
    Dim c1 As Workbook
    Dim c2 As Workbook
    Dim sh As Chart
    Dim f As Worksheet
    Dim compteur
 
    Set c1 = ThisWorkbook
    Set c2 = Workbooks.Add(1)
 
    compteur = 0
 
    For Each sh In c1.Charts
       compteur = compteur + 1
 
       Set f = c2.Sheets.Add(before:=c2.Sheets(1))
       f.Name = "Graph" & compteur
 
       If Left(sh.Name, 5) = "Graph" Then
           sh.CopyPicture Appearance:=xlScreen, Format:=xlPicture
           f.PasteSpecial Format:="Image (métafichier amélioré)", Link:=False, DisplayAsIcon:=False
       End If
    Next sh
End Sub

[mercatog]

Bonjour
En travaillant avec des variables objet et sans les Select/Activate, tu aurais mois de problèmes.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Public Sub ExporterGraphiques()
Dim Wbk As Workbook
Dim Sh As Worksheet
Dim Ch As Chart
Dim i As Integer
 
Application.ScreenUpdating = False
Set Wbk = Workbooks.Add(1)
For Each Ch In ThisWorkbook.Charts
    If Left(Ch.Name, 5) = "Graph" Then
        i = i + 1
        Set Sh = Wbk.Worksheets.Add(before:=Wbk.Sheets(1))
        Sh.Name = "Graph" & i
        Ch.ChartArea.Copy
        Sh.PasteSpecial Format:="Image (métafichier amélioré)", Link:=False, DisplayAsIcon:=False
    End If
Next Ch
Wbk.SaveAs Filename:=ThisWorkbook.Path & "\RecapGraph", FileFormat:=xlNormal
Wbk.Close False
Set Wbk = Nothing
End Sub

[Arapaima]

Merci pour vos réponses !