Path not found - exportchart

Le 30/07/2021 à 10:55

Bonjour,

Je fais appel à votre aide pour l'export d'une image. Il m'est impossible d'integrer une variable dans le nom.

Voici le code :

Sub exportphoto()

Dim cht As ChartObject
Dim ActiveShape As Shape
Dim simple As Range, doublev As Range, triplev As Range, quadruplev As Range, doubleh As Range, tripleh As Range, quadrupleh As Range
Dim refp As String, refm As String

Dim fpath As String, Title As String
Dim Graph As Chart

Set simple = Sheets("Configurateur").Range("R2:R10")
Set doublev = Sheets("Configurateur").Range("R2:R14")
Set triplev = Sheets("Configurateur").Range("R2:R22")
Set quadruplev = Sheets("Configurateur").Range("R2:R30")
Set doubleh = Sheets("Configurateur").Range("R2:T10")
Set tripleh = Sheets("Configurateur").Range("R2:V10")
Set quadrupleh = Sheets("Configurateur").Range("R2:X10")

fpath = "C:\Users\farreneit\Downloads\"

 refp = Sheets("Configurateur").[D7]
 refm = Sheets("Configurateur").[D15]

'Copy/Paste Cell Range as a Picture

If Sheets("Configurateur").[G5] = "1C" Then
    simple.Copy

    ElseIf Sheets("Configurateur").[G5] = "2V" Then
        doublev.Copy

    ElseIf Sheets("Configurateur").[G5] = "3V" Then
        triplev.Copy

    ElseIf Sheets("Configurateur").[G5] = "4V" Then
        quadruplev.Copy

    ElseIf Sheets("Configurateur").[G5] = "2H" Then
        doubleh.Copy

    ElseIf Sheets("Configurateur").[G5] = "3H" Then
        tripleh.Copy

    ElseIf Sheets("Configurateur").[G5] = "4H" Then
        quadrupleh.Copy

End If

  ActiveSheet.Pictures.Paste(link:=False).Select
  Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)

'Create a temporary chart object (same size as shape)
  Set cht = ActiveSheet.ChartObjects.Add( _
    Left:=ActiveCell.Left, _
    Width:=ActiveShape.Width, _
    Top:=ActiveCell.Top, _
    Height:=ActiveShape.Height)

'Format temporary chart to have a transparent background
  cht.ShapeRange.Fill.Visible = msoFalse
  cht.ShapeRange.Line.Visible = msoFalse

'Copy/Paste Shape inside temporary chart
  ActiveShape.Copy
  cht.Activate
  ActiveChart.Paste

'Save chart to User's Desktop as PNG File

  cht.Chart.Export fpath & refp & "_" & refp & ".jpg"

'Delete temporary Chart
  cht.Delete
  ActiveShape.Delete

End Sub

Si je remplace

 refp & "_" & refp

par "texte", l'image se créée bien avec le titre texte.jpg, sinon cela me met une erreur "path not found".

Merci d'avance et bonne journée !

Le 30/07/2021 à 11:44

Bonjour,

Petite question avant tout : c'est refp & "_" & refp ou refp & "_" & refm ?

Je pense que la variable refp contient un caractère qui n'est pas autorisé dans les noms de fichier.

Voici un essai avec saisie du nom de fichier dans une boite de dialogue :

Sub exportphoto()

Dim cht As ChartObject
Dim ActiveShape As Shape
Dim simple As Range, doublev As Range, triplev As Range, quadruplev As Range, doubleh As Range, tripleh As Range, quadrupleh As Range
Dim refp As String, refm As String

Dim fpath As String, Title As String
Dim Graph As Chart

Set simple = Sheets("Configurateur").Range("R2:R10")
Set doublev = Sheets("Configurateur").Range("R2:R14")
Set triplev = Sheets("Configurateur").Range("R2:R22")
Set quadruplev = Sheets("Configurateur").Range("R2:R30")
Set doubleh = Sheets("Configurateur").Range("R2:T10")
Set tripleh = Sheets("Configurateur").Range("R2:V10")
Set quadrupleh = Sheets("Configurateur").Range("R2:X10")

fpath = "C:\Users\farreneit\Downloads\"

 refp = Sheets("Configurateur").[D7]
 refm = Sheets("Configurateur").[D15]

'Copy/Paste Cell Range as a Picture

If Sheets("Configurateur").[G5] = "1C" Then
    simple.Copy

    ElseIf Sheets("Configurateur").[G5] = "2V" Then
        doublev.Copy

    ElseIf Sheets("Configurateur").[G5] = "3V" Then
        triplev.Copy

    ElseIf Sheets("Configurateur").[G5] = "4V" Then
        quadruplev.Copy

    ElseIf Sheets("Configurateur").[G5] = "2H" Then
        doubleh.Copy

    ElseIf Sheets("Configurateur").[G5] = "3H" Then
        tripleh.Copy

    ElseIf Sheets("Configurateur").[G5] = "4H" Then
        quadrupleh.Copy

End If

  ActiveSheet.Pictures.Paste(link:=False).Select
  Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)

ExportShapeToJPG Activeshape, true
 
End Sub

Public Function ExportShapeToJPG(Forme As Shape, Optional OpenAfterExport As Boolean) As Boolean
'adapté de : https://excel-malin.com/vba-astuces/excel-vers-jpg/
ActiveWindow.DisplayGridlines = False 'cacher ou afficher les lignes de grille
On Error GoTo fin
With Forme
    .CopyPicture Appearance:=xlScreen, Format:=xlPicture 'Copier dans le Presse-papier
    With .Parent.ChartObjects.Add(.Left, .Top, .Width, .Height).Chart 'création nouveau graph temporaire (pour méthode Export)
        .Paste
        .ChartArea.Format.Line.Visible = msoFalse
        sfilename = Application.GetSaveAsFilename(".jpg", "Image file (*.jpg), *.jpg")
        If sfilename = False Then GoTo fin Else .Export sfilename
    End With
    ExportShapeToJPG = True
    If OpenAfterExport Then Shell Environ("WINDIR") & "\explorer.exe " & sfilename, vbNormalFocus
fin:
    If .Parent.ChartObjects.Count > 0 Then .Parent.ChartObjects(.Parent.ChartObjects.Count).Delete
End With
ActiveWindow.DisplayGridlines = True
End Function

Ca permettra d'être fixé sur la validité du nom désiré.

Cdlt,

Le 30/07/2021 à 15:13

Merci beaucoup !

Cela venait en effet du nom ... un caractère non autorisé !

Merci beaucoup pour ton aide !

J'aimerais en profiter pour te demander de l'aide sur un autre problème :

La photo exportée contient deux lignes grises que je ne souhaiterais pas avoir.

Voilà à quoi cela doit ressembler :

exemple

Voilà ce que j'obtiens : (bizarrement, lorsque j'ajoute le fichier jpg directement au forum les lignes grises ne s'affichent pas ...)

capture

Et voilà mon code :

Sub exportphoto()

Dim cht As ChartObject
Dim ActiveShape As Shape
Dim simple As Range, doublev As Range, triplev As Range, quadruplev As Range, doubleh As Range, tripleh As Range, quadrupleh As Range
Dim refp As String, refm As String

Dim fpath As String, Title As String
Dim Graph As Chart

Set simple = Sheets("Configurateur").Range("R2:R10")
Set doublev = Sheets("Configurateur").Range("R2:R14")
Set triplev = Sheets("Configurateur").Range("R2:R22")
Set quadruplev = Sheets("Configurateur").Range("R2:R30")
Set doubleh = Sheets("Configurateur").Range("R2:T10")
Set tripleh = Sheets("Configurateur").Range("R2:V10")
Set quadrupleh = Sheets("Configurateur").Range("R2:X10")

fpath = "C:\Users\farreneit\Downloads\"

 refp = Sheets("Configurateur").[D7]
 refm = Sheets("Configurateur").[D15]

'Copy/Paste Cell Range as a Picture

If Sheets("Configurateur").[G5] = "1C" Then
    simple.Copy

    ElseIf Sheets("Configurateur").[G5] = "2V" Then
        doublev.Copy

    ElseIf Sheets("Configurateur").[G5] = "3V" Then
        triplev.Copy

    ElseIf Sheets("Configurateur").[G5] = "4V" Then
        quadruplev.Copy

    ElseIf Sheets("Configurateur").[G5] = "2H" Then
        doubleh.Copy

    ElseIf Sheets("Configurateur").[G5] = "3H" Then
        tripleh.Copy

    ElseIf Sheets("Configurateur").[G5] = "4H" Then
        quadrupleh.Copy

End If

  ActiveSheet.Pictures.Paste(link:=False).Select
  Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)

'Create a temporary chart object (same size as shape)
  Set cht = ActiveSheet.ChartObjects.Add( _
    Left:=ActiveCell.Left, _
    Width:=ActiveShape.Width, _
    Top:=ActiveCell.Top, _
    Height:=ActiveShape.Height)

'Format temporary chart to have a transparent background
ActiveWindow.DisplayGridlines = False
  cht.ShapeRange.Line.Visible = msoFalse

'Copy/Paste Shape inside temporary chart
  ActiveShape.Copy
  cht.Activate
  ActiveChart.Paste

'Save chart to User's Desktop as PNG File

  cht.Chart.Export fpath & refp & "_" & refm & ".jpg"

'Delete temporary Chart
  cht.Delete
  ActiveShape.Delete

End Sub

Merci d'avance !!

Le 30/07/2021 à 15:50

Nickel !

Pour ce second problème, je me souviens l'avoir rencontré déjà mais je ne suis pas certain d'être parvenu à le résoudre.

En fait, il s'agit probablement de la bordure du graphique qui demeure malgré nos tentatives de la rendre invisible... A ta place, j'essaierais quand même de changer cette ligne :

cht.ShapeRange.Line.Visible = msoFalse

par

cht.chart.chartarea.format.Line.Visible = msoFalse

Mais il est probable que ça ne change rien...

Le 30/07/2021 à 16:03

Encore merci pour la réponse !

Effectivement cela n'a rien changé ...

Est-ce qu'il n'y aurait pas un moyen de programmer un "crop" de l'image exportée pour ne plus avoir ces traits en plus ?

Ou si tu penses à une autre solution ?

Le 30/07/2021 à 16:27

Franchement, je n'ai pas vraiment d'idée. J'avais quand même fait pas mal d'essais mais je suis peut-être passé à côté de LA propriété à modifier...

J'ai donc abandonné et accepté ce résultat avec la légère bordure. Je t'encourage à faire de même, si c'est possible.

Sinon, il est toujours envisageable de rogner l'image par la suite mais ça me semble quand même lourd et instable. En tout cas, tu peux essayer en utilisant l'enregistreur de macros pour voir ce que ça donne...

Le 30/07/2021 à 16:32

C'est noté merci beaucoup pour ton retour !

Rechercher des sujets similaires à "path found exportchart"