Discussion :

[patmeziere]

re
a ben vla que je fait les choses a l'envers maintenant

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
28
29
30
31
32
33
34
35
36
37
38
39
Sub test()
CopyOBJECTInImagePNG ActiveSheet.UsedRange.Resize(, [o1].Column), Environ("userprofile") & "\desktop\monimage.png"
End Sub
 
Function CopyOBJECTInImagePNG(ObjectOrRange, _
                              Optional cheminx As String = "", _
                              Optional transparency As Boolean = False) As String
    Dim Graph As Object
    If cheminx = "" Then cheminx = ThisWorkbook.Path & "\imagetemp.png" 'path du fichier par defaut
 
    With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text") 'on vide le clipboard entre chaque copie pour tester vraiment le available
    End With
 
    ObjectOrRange.CopyPicture 'Format:=IIf(Notransparency, xlBitmap, xlPicture)
    Set Graph = ObjectOrRange.Parent.ChartObjects.Add(0, 0, 0, 0).Chart
    Graph.Parent.ShapeRange.Line.Visible = msoFalse
    With Graph.Parent
        .Width = ObjectOrRange.Width: .Height = ObjectOrRange.Height: .Left = ObjectOrRange.Width + 20:
        .Select
        Do: DoEvents: .Chart.Paste: Loop While .Chart.Pictures.Count = 0
 
        With .Chart
            .ChartArea.Fill.Visible = msoTrue
            .ChartArea.Fill.Solid
            If transparency Then
                If TypeOf ObjectOrRange Is Range Then
                      .ChartArea.Format.Fill.transparency = 0.1
             Else:
                    .ChartArea.Format.Fill.transparency = 1
                     End If
            Else
                .ChartArea.Format.Fill.transparency = 0
            End If
            .Export cheminx, Split(cheminx, ".")(1)
        End With
    End With
    Graph.Parent.Delete
    CopyOBJECTInImagePNG = cheminx
End Function

[goninph]

en supprimant ce code, ça fonctionne aussi ...

A qoui sert ce code ?

Code :

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

1
2
3
4
5
6
7
8
9
'            If transparency Then
'                If TypeOf ObjectOrRange Is Range Then
'                    .ChartArea.Format.Fill.transparency = 1
'                    Else:
'                    .ChartArea.Format.Fill.transparency = 0.99
'                End If
'            Else
'                .ChartArea.Format.Fill.transparency = 0
'            End If

[patmeziere]

re
oui mais ce n'est pas du vrai png
c'est pas pour rien que je ne supprime pas le fillarea et le garde comme calque transparent
sans ce code tu sauve avec le nom "blblbla.png" mais c'est un .jpg en fait
allez pour faire bien les choses on change le switch

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
28
29
30
31
32
33
34
35
Sub test()
CopyOBJECTInImagePNG ActiveSheet.UsedRange.Resize(, [o1].Column), Environ("userprofile") & "\desktop\monimage.png"
End Sub
 
Function CopyOBJECTInImagePNG(ObjectOrRange, _
                              Optional cheminx As String = "", _
                              Optional transparency As Boolean = False) As String
    Dim Graph As Object
    If cheminx = "" Then cheminx = ThisWorkbook.Path & "\imagetemp.png" 'path du fichier par defaut
 
    With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text") 'on vide le clipboard entre chaque copie pour tester vraiment le available
    End With
 
    ObjectOrRange.CopyPicture 'Format:=IIf(Notransparency, xlBitmap, xlPicture)
    Set Graph = ObjectOrRange.Parent.ChartObjects.Add(0, 0, 0, 0).Chart
    Graph.Parent.ShapeRange.Line.Visible = msoFalse
    With Graph.Parent
        .Width = ObjectOrRange.Width: .Height = ObjectOrRange.Height: .Left = ObjectOrRange.Width + 20:
        .Select
        Do: DoEvents: .Chart.Paste: Loop While .Chart.Pictures.Count = 0
 
        With .Chart
            .ChartArea.Fill.Visible = msoTrue
            .ChartArea.Fill.Solid
            If transparency Then
                    .ChartArea.Format.Fill.transparency = 1
                Else
                .ChartArea.Format.Fill.transparency = 0.01
            End If
            .Export cheminx, Split(cheminx, ".")(1)
        End With
    End With
    Graph.Parent.Delete
    CopyOBJECTInImagePNG = cheminx
End Function

true si tu veux transparent rien si tu veux plein pour le 3eme argument