Discussion :

[brioche31]

Bonjour

Je ne connais que très très peu le VBA donc je galère pas mal ..

J'ai un code qui permet de copier une feuille vers une nouvelle en choisissant le nom dans une fenêtre . Cela fonctionne, mais par contre il y à des graphiques qui gardent les liens avec les données ce que je ne veux pas ! j'aimerai qu'ils soient copiés en format images. j'ai trouvé des commandes VBA pour ça mais impossible )à placer dans le code que j'ai sans erreurs.. de plus il me copie aussi les boutons VBA de commandes ce que je ne veux pas, je désire juste les tableaux et les graphiques en images c est tout !

Voici la partie du code de copie:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub OK_Click()
If ComboBox1 = "" Then
MsgBox ("VEUILLEZ SELECTIONNER LA SEMAINE A CREER")
Exit Sub
End If
For I = 1 To Sheets.Count
If UCase(Left(Sheets(I).Name, Len(ComboBox1))) = UCase(ComboBox1) Then
MsgBox ("La feuille " & UCase(ComboBox1) & " existe déjà, si vous désirez regénérer une feuille de données veuillez la supprimer avant toute action")
Exit Sub
End If
Next I
' Copie de la feuille "Reporting" sans les formules pour éviter que les données se mettent à jours
 Application.ScreenUpdating = False
 Sheets("Reporting").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
     .Name = UCase(ComboBox1) & "_" & Format(Now, "yyyy")
     With .UsedRange
         .Value = .Value
     End With
End With
Unload Me
End Sub

Merci les gens d'avance !

[Ben_L]

Bonjour,

Le plus simple semble de copier la feuille, puis de supprimer toutes les Shapes présentes dans la copie.
Une boucle sur les Shapes de la feuille d'origine vous permettra alors de repérer les graphiques et de les copier comme vous le souhaitez.

Cela pourrait donner quelque chose comme ça (simplifier au max, à adapter à votre cas) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub CeciEstUnTest()
    Dim Sht As Sheet, Shp As Shape, Chrt As Chart, Nam As String, Rng As Range
    Sheets("Reporting").Copy After:=Sheets(Sheets.Count)
    Set Sht = Sheets(Sheets.Count)
    On Error Resume Next
    With Sht
        For Each Shp In .Shapes
            Set Chrt = Shp.Chart
            If Err.Number <> 0 Then
                Err.Clear
            Else
                Nam = Shp.Name
                Set Rng = Shp.TopLeftCell
                Shp.Delete
                Sheets("Reporting").Shapes(Nam).CopyPicture xlScreen, xlBitmap
                .Paste  Destination:=Rng
            End If
        Next Shp
    End With
    On Error Goto 0
End Sub

Je précise que je n'ai pas testé ce code...