Discussion :

[debdev]

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 :

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

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

[Jean-Philippe André]

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 :

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

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

version plus complète :

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
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

[debdev]

Hello !

Merci bcp !

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 :

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
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