histogramme avec trait superposé: exporter le tout en image

Version imprimable

Bonjour,

J'ai un histogramme 3D. Comme il n'est pas possible d'ajouter un autre type de graphique que celui déjà existant pour la 3D, j'ai bidouillé mon graphique en ajoutant dessus un trait (insertion/formes).

J'ai un code VBA qui me permet d'exporter tous mes graphiques en image: mais même si je groupe l'histogramme et le trait, le trait n'apparait jamais sur l'image.

Auriez-vous une idée ?
Merci

Le code VBA:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Private Sub EnregistreGraphique() Dim Dest As String Dim NomGraph As String Dim j As Byte, i As Byte Dim Ch As Chart Dest = "C:/.../" For j = 1 To Sheets.Count For i = 1 To Sheets(j).ChartObjects.Count NomGraph = Sheets(j).ChartObjects(i).Name Sheets(j).ChartObjects(i).Chart.Export Filename:=Dest & NomGraph & ".png" Next i Next j End Sub

salut,

ton trait en question n'est pas lié à ton chart je pense, ce qui explique le fait qu'il ne soit pas incorporé dans ton export image.

deux pistes de code :
version basique

Code:

1
2
3
Sub Macro1() 
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap 
End Sub

version plus complète :

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
Sub ExportScreenShot() 
    Const FName As String = "C:\My Documents\My Screenshots\Screenshot.jpg" 
    Dim pic_rng As Range 
    Dim ShTemp As Worksheet 
    Dim ChTemp As Chart 
    Dim PicTemp As Picture 
    Application.ScreenUpdating = False 
    Set pic_rng = Worksheets("Sheet1").Range("A30:G56") 
    Set ShTemp = Worksheets.Add 
    Charts.Add 
    ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name 
    Set ChTemp = ActiveChart 
    pic_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture 
    ChTemp.Paste 
    Set PicTemp = Selection 
    With ChTemp.Parent 
        .Width = PicTemp.Width + 8 
        .Height = PicTemp.Height + 8 
    End With 
    ChTemp.Export Filename:="C:\My Documents\My Screenshots\Screenshot.jpg", FilterName:="jpg" 
     'UserForm1.Image1.Picture = LoadPicture(FName)
     'Kill FName
    Application.DisplayAlerts = False 
    ShTemp.Delete 
    Application.DisplayAlerts = True 
    Application.ScreenUpdating = True 
End Sub

Hello !

Merci bcp ! :ccool:

Ton code fonctionne parfaitement. Le seul petit bémol, c'était la résolution de l'image. J'ai cherché sur le net, et j'ai trouvé quelquechose que j'ai ajouté dans ton code.

Bonne journée !

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
Sub ExportScreenShot()
    Dim z
    Dim pic_rng As Range
    Dim ShTemp As Worksheet
    Dim ChTemp As Chart
    Dim PicTemp As Picture
    z = ActiveWindow.Zoom
    Application.ScreenUpdating = False
    Set pic_rng = Worksheets("NomWorksheet").Range("A1:L40")
    Set ShTemp = Worksheets.Add
    Charts.Add
    ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name
    Set ChTemp = ActiveChart
    pic_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    ChTemp.Paste
    Set PicTemp = Selection
    With ChTemp.Parent
        .Width = pic_rng.Width * z / 100
        .Height = pic_rng.Height * z / 100
    End With
    ChTemp.Export Filename:="C:/Documents and Settings/.../Screenshot.jpg", FilterName:="jpg"
    Application.DisplayAlerts = False
    ShTemp.Delete
    Application.DisplayAlerts = True
End Sub