XL 2016 Exportation d'image de la feuille

[Didou1]

Bonjour le forum,

Voilà je vous expose mon problème j'ai un masque sur Excel qui me sert de saisie avec une mise en page
Jusqu'à maintenant j'avais un code qui me permettait d'exporter ma plage dans un format PDF ce qui me permettait de l'enregistrer directement dans le répertoire de mon disque dur.

Je souhaite maintenant faire la même chose mais le transformer directement en format JPEG.

J'ai trouvé ce code sur Internet que j'ai adapté, le problème c'est qu'à l'ouverture du graphe il y a des informations qui apparaît
des axes
un quadrillage
une légende
Et un titre du graphique courbe


Auriez-vous une idée à ma portée pour modifier ce code

Merci de votre aide

Public Function ExporterPlageCommeImage2(PlageAExporter As Range, LignesDeGrille As Boolean, FichierImage As String)

On Error GoTo FonctionErreur


PlageAExporter.CopyPicture Appearance:=xlScreen, Format:=xlPicture


With ActiveSheet.ChartObjects.Add(Left:=PlageAExporter.Left, Top:=PlageAExporter.Top, _
Width:=PlageAExporter.Width, Height:=PlageAExporter.Height)

.Name = "ExportImage"
.Activate
End With

ActiveChart.Paste
ActiveSheet.ChartObjects("ExportImage").Chart.Export FichierImage
ActiveSheet.ChartObjects("ExportImage").Delete


Exit Function
FonctionErreur:
MsgBox "Une erreur est survenue..."
End Function

Sub ExempleExportImage()

Application.ScreenUpdating = False
On Error GoTo ExportErreur

Dim Plage As Range
Dim FichierImage As String
Dim AfficherGrilles As Boolean

Set Plage = Workbooks("MENU.xlsb").Sheets("MENU").Range("Q1:T39").Cells
FichierImage = "C:\Users\MonImageExcel.jpg"
AfficherGrilles = True
Workbooks("MENU.xlsb").Activate
ExportFichier = ExporterPlageCommeImage2(Plage, AfficherGrilles, FichierImage)

Application.ScreenUpdating = True
Exit Sub
ExportErreur:
MsgBox "Une erreur est survenue..."
Application.ScreenUpdating = True
End Sub

 

[patricktoulon]

bonjour
exemple avec boite de dialogue saveAs

Sub test()
    exportRangeToJpg Feuil1.[c5:E18]
End Sub

Private Sub exportRangeToJpg(Rng)
    Dim chemin
    Application.ScreenUpdating = False
    chemin = Application.GetSaveAsFilename(InitialFileName:=CurDir, filefilter:="image Files (*.jpg), *.jpg", Title:="ENREGISTREMENT DE LA CAPTURE")
    If chemin <> False And Not Rng Is Nothing Then
             Rng.CopyPicture
            Set chart1 = Rng.Parent.ChartObjects.Add(0, 0, Rng.Width, Rng.Height).Chart
            With chart1
                With .Parent
                    T = Timer: Do: DoEvents: Loop While Timer - T < 1
                    .Chart.Paste
                    Do: DoEvents: Loop While .Chart.Pictures.Count = 0
                     .Chart.Export chemin, "jpg"
                    .Delete
                End With
            End With
          End If
End Sub

 

[Didou1]

Bonjour PatrickToulon

Je viens de tester ton code adapté à mon fichier il me bloque excel

J'ai lancé le code pas à pas, Il bloque sur cette ligne

 

[patricktoulon]

re
cette erreur n'a pas de sens, ça arrive souvent quand une référence est manquante (vérifie)
je l'ai testé sur 2007 et 2013

 

[Didou1]

Je suis bien embêté je viens de tester sur le fichier vierge

je n'ai aucune image qui s'enregistre dans le répertoire que j'ai sélectionné

 

[patricktoulon]

re
heu .. la c'est grave je viens d'essayer ton fichier et il marche très bien
a tu les droits sur ce dossier au moins
choisi le bureau pour tester

 

[Didou1]

Effectivement c'est un mystère
Je viens de tester sur une autre machine avec Excel 2019 même problème
Je suis obligé de réinitialiser la macros pour qu'elle s'arrête

Et voilà ce qui apparaît après sur la feuille
les mêmes problèmes que je retrouve avec mon code sur ligne série etc.

 

[patricktoulon]

bizarre ton truc
tu fait bien un copy picture
si tu fait un simple copy c'est normal

 

[Didou1]

c'est a dire
je lance le code tout simplement

 

[Didou1]

Ok trouvé

 

[patricktoulon]

OK alors c'etait quoi ????
partage d'autre auront peut être le même soucis

 

[Didou1]

BonjourPatrickToulon

Tu es sur Excel 2010
cela fonctionne sur 2010 mais pas après tu me confirme

 

[Didou1]

Dans référence object Library et 16.0
sur le pc en excel 2010 je suis en 14.0
tu pense que c'est le problème

 

[Didou1]

Bonjour

Plus réponse

merci pour aide le forum