Enregistrement cellle au format JPEG

Bonjour tout le monde,

J'aimerai enregistrer automatiquement une certaine plage de cellules dans un dossier ciblé sous format jpeg, et cela sans fenêtre de validation.

J'ai bien fouillé sur le forum, et dans le topic https://forum.excel-pratique.com/viewtopic.php?t=88624 j'ai réussi à en tirer le code ci-dessous qui effectue la manipulation.

Cependant avec la fonction

Application.GetSaveAsFilename

, je n'arrive pas à faire en sorte que le dossier soit sélectionné automatiquement, plutôt que d'ouvrir la fenêtre d'enregistrement pour que je la sélectionne.

J'ai recherché des infos sur le net sur l'application GetSaveAsFilename, j'ai aussi tenté d'ajouter un "ChDir", mais en vain.

Est-ce que quelqu'un pourrait m'aiguiller sur ça ?

Je vous remercie d'avance !

Sub Impression_KAMI()

    Application.ScreenUpdating = False
    On Error GoTo ExportErreur

    Dim Plage As Range
    Dim FichierImage As Variant

    Set Plage = Range("A5:I47").Cells 'Ma plage de cellule à copier
    Plage.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    With ActiveSheet.ChartObjects.Add(Left:=Plage.Left, Top:=Plage.Top, Width:=Plage.Width, Height:=Plage.Height)
        .Name = "ExportImage"
        .Activate
    End With
    ActiveChart.Paste

ChDir "C:\Users\R\Pictures\"     'Pour direction du dossier

    FichierImage = Application.GetSaveAsFilename(InitialFileName:="KAMI.jpg", fileFilter:="Image file (*.jpg), *.jpg")
    If FichierImage <> False Then
        ActiveSheet.ChartObjects("ExportImage").Chart.Export FichierImage
    End If
    ActiveSheet.ChartObjects("ExportImage").Delete
    Application.ScreenUpdating = True
    Exit Sub
ExportErreur:
    MsgBox "Une erreur est survenue..."
    Application.ScreenUpdating = True

End Sub

Bonjour,

à tester,

Sub Impression_KAMI()
    Dim Plage As Range
    Dim FichierImage As Variant

    Set Plage = Range("A5:I47") 'Ma plage de cellule à copier

    With ActiveSheet.ChartObjects.Add(Left:=Plage.Left, Top:=Plage.Top, Width:=Plage.Width, Height:=Plage.Height)
        .Name = "ExportImage"
        .Activate
    End With

    Plage.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    ActiveChart.Paste

    ActiveSheet.ChartObjects("ExportImage").Chart.Export "C:\Users\R\Pictures\KAMI.jpg"
End Sub

Bonjour i20100,

Je te remercie pour ta réponse. j'ai testé ton code, l'enregistrement se fait mais malheureusement l'image enregistrée est un simple fond blanc.

Est-ce que ce serai du à une compatibilité d'excel ? Je suis sur windows 10 avec Office 2016.

Merci !

re,

à tester,

Toujours le même soucis, je joins le fichier test que tu m'as donné pour que tu puisses le visualiser.

Il semblerait que le chart qu'il créé est vide, et donc l'image sauvegardée est un simple rectagle blanc chez moi...

Ca focntionne bien chez toi ?

re,

pour ciblé le problème, peux-tu faire le test suivant

Sub test()
    Dim Plage As Range
    Dim FichierImage As Variant

    Set Plage = Range("A5:I47") 'Ma plage de cellule à copier

    Plage.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Range("M1").Select
    ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False
End Sub

Re,

Le code que tu viens de me donner fonctionne, il me génère bien une Picture de la plage sélectionnée.

re,

nouvelle version à tester,

Aïe, retour au soucis initial...

re,

as-tu essayé d’exécuter le code en mode pas à pas (touche F8) ?

re,

une nouveauté pour xl2016

.ChartArea.Parent.Select    'new for Excel 2016

nouveau code

Sub Impression_KAMI()
Dim Plage As Range
Dim FichierImage As Variant

Set Plage = Range("A5:I47") 'Ma plage de cellule à copier

Call ViderPressePapier

Set graph = ActiveSheet.ChartObjects.Add(Left:=Plage.Left, Top:=Plage.Top, Width:=Plage.Width, Height:=Plage.Height)
Plage.CopyPicture
With graph
    .ChartArea.Parent.Select    'new for Excel 2016
    .Paste
    .Export "C:\Users\R\Pictures\KAMI.jpg", GIF
End With

Set Plage = Nothing
End Sub

Bonjour,

Oui j'ai bien exécuté en mode pas à aps détaillé, et l'image est générée en blanc lors de la copie, avant l'exportation.

Sur ton code ci-dessous, l'image était bien générée correctement en format Picture. Est-ce qu'il y aurait une fonction permettant d'exporter cette Picture en format jpeg ?

Merci pour ton aide

Sub test()
    Dim Plage As Range
    Dim FichierImage As Variant

    Set Plage = Range("A5:I47") 'Ma plage de cellule à copier

    Plage.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Range("M1").Select
    ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False
End Sub

EDIT :

Je viens de tester le code tu m'as fourni plus haut avec la nouveauté pour excel 2016, cependant lors de la copie le chart est également blanc, et il m'affiche une "erreur d'exécution '438' : Propriété ou méthode non gérée par cet objet." au niveau de la ligne

.ChartArea.Parent.Select 

EDIT 2 :

L'erreur générée venait d'un .Chart manquant au niveau du with :

With Graph.Chart
    .ChartArea.Select    'new for Excel 2016
    .Paste
    .Export ThisWorkbook.Path & "\KAMI.jpg", "GIF" 'pour le test,
End With

Malheureusement le problème initial persiste, le graph généré reste blanc....

Bonsoir Vikto_ et Isabelle,

voici ma suggestion:

Sub CopieImage()

    Dim Plage  As Range
    Dim Chemin As String, MonImage As String

    Application.ScreenUpdating = False

    Set Plage = Range("A5:I47")                   'Ma plage de cellule à copier
    Chemin = "C:\UsersSequoyah\Desktop\" '<<== à adapter
    MonImage = "Test.jpg" '<<== à adapter

    Plage.CopyPicture

    With ActiveSheet.ChartObjects.Add(0, 0, Plage.Width, Plage.Height).Chart
        .Parent.Activate
        .Paste
        .Export Filename:=Chemin & MonImage, FilterName:="jpg"
        .Parent.Delete
    End With

   Application.ScreenUpdating = True

End Sub

Cordialement

Bonjour Sequoyah,

Je te remercie pour ta proposition de code, que je viens de tester et qui semble marcher !

Il y a juste un détail, la plage de cellule enregistrée en .jpg ne semble pas correspondre à celle définie dans le code.

Par exemple, le .jpg enregistré est en partie coupé, par contre lors du mode pas à pas détaillé, la plage copiée correspond bien à l'image en entier... De mon point de vue, on dirait que ça vient de la taille du graphique, mais je n'en suis pas certain.

Bonjour Vikto_

chez moi le code marche bien, tu est sûr que la dernière image collée a été supprimée?

De plus dans ton fichier le code n'est pas complet, ça devrait être:

Chemin = ThisWorkbook.Path & "/"

Bonjour Sequoyah,

Je viens de tester à nouveau ce matin, et effectivement le code fonctionne correctement...

Bizarre, mais bon tant mieux !

En tout cas merci beaucoup à vous deux pour m'avoir accordé votre temps !