Enregistrer une plage de cellule en image

Bonjour à tous

J'ai déniché ce code pour enregistrer une plage de cellule en image mais j'ai du mal à me l'approprier totalement.

Plutôt que de laisser le choix à l'utilisateur le chemin d'enregistrement de l'image j'aimerais la définir.

En fait ce que je souhaiterai c'est enregistrer l'image deux fois vers deux chemins différents et avec leur nom différent, mais malgré mes essais et mes connaissances limitées je n'arrive pas faire ce que je veux du code ...

Si quelqu'un veut bien me donner un coup de pouce.

Merci d'avance et bonne après-midi

Option Explicit

Sub EnregistrerImage()
' Exporter la plage de cellules sélectionnée vers une image PNG

Dim rngToPNG As Range           ' La plage à enregistrer
Dim booGrid As Boolean          ' Pour rétablir la grille telle qu'elle
Dim varExportPath As Variant    ' Chemin complet d'enregistrement de l'image

' Sélection de la plage de cellule

    Range("A1:D10").Select

' Demande à l'utilisateur le chemin où enregistrer l'image

    varExportPath = Application.GetSaveAsFilename(ActiveWorkbook.Path & "\image.png", "Image (*.png),*.png", , "Enregistrer sous forme d'image")
If varExportPath <> False Then

    ' Masquer les coulisses
    Application.ScreenUpdating = False              ' Figer l'écran
    booGrid = ActiveWindow.DisplayGridlines         ' Mémoriser la grille
    ActiveWindow.DisplayGridlines = False           ' Masquer la grille

    ' Mémoriser la zone sélectionnée par l'utilisateur
    Set rngToPNG = Selection

    ' Sélectionner une cellule très loin du tableau pour être sûr que la création de la zone de graphique soit vide
    Range("A1").SpecialCells(xlLastCell).Offset(5, 5).Select

    ' Création d'une zone de graphique et sélection de celle-ci
    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    ' Redimentionnement à la taille de la zone de cellules
    ActiveSheet.Shapes(1).Height = rngToPNG.Rows.Height
    ActiveSheet.Shapes(1).Width = rngToPNG.Columns.Width
    ' Copier la zone de cellules sous forme d'image
    rngToPNG.CopyPicture xlScreen, xlPicture
    ' Collage dans la zone de graphique
    ActiveChart.Paste

    ' Export sous forme d'image
    ActiveChart.Export Filename:=varExportPath, FilterName:="PNG"

    ' Retour à la normale
    ActiveSheet.Shapes(1).Delete
    rngToPNG.Select
    ActiveWindow.DisplayGridlines = booGrid
    Application.ScreenUpdating = True

    ' Confirmation
    MsgBox "L'image a bien été enregistrée...", vbInformation
End If

End Sub

Bonjour à tous !

Après une nuit de réflexion j'ai réussi à débloquer la situation (je vais valider ma propre réponse pour une fois !).

Il fallait "juste" intégrer le chemin dans

 varExportPath = 

pour ceux qui sont intéressés.

Bonne journée et bonne continuation

Dim rngToPNG As Range           ' La plage à enregistrer
Dim booGrid As Boolean          ' Pour rétablir la grille telle qu'elle
Dim varExportPath As Variant    ' Chemin complet d'enregistrement de l'image

' Sélection de la plage de cellule

    Range("A1:D10").Select

' Demande à l'utilisateur le chemin où enregistrer l'image

    varExportPath = "C:\Chemin\Image.png" 'Application.GetSaveAsFilename(ActiveWorkbook.Path & "\image.png", "Image (*.png),*.png", , "Enregistrer sous forme d'image")
If varExportPath <> False Then

    ' Masquer les coulisses
    Application.ScreenUpdating = False              ' Figer l'écran
    booGrid = ActiveWindow.DisplayGridlines         ' Mémoriser la grille
    ActiveWindow.DisplayGridlines = False           ' Masquer la grille

    ' Mémoriser la zone sélectionnée par l'utilisateur
    Set rngToPNG = Selection

    ' Sélectionner une cellule très loin du tableau pour être sûr que la création de la zone de graphique soit vide
    Range("A1").SpecialCells(xlLastCell).Offset(5, 5).Select

    ' Création d'une zone de graphique et sélection de celle-ci
    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    ' Redimentionnement à la taille de la zone de cellules
    ActiveSheet.Shapes(1).Height = rngToPNG.Rows.Height
    ActiveSheet.Shapes(1).Width = rngToPNG.Columns.Width
    ' Copier la zone de cellules sous forme d'image
    rngToPNG.CopyPicture xlScreen, xlPicture
    ' Collage dans la zone de graphique
    ActiveChart.Paste

    ' Export sous forme d'image
    ActiveChart.Export Filename:=varExportPath, FilterName:="PNG"

    ' Retour à la normale
    ActiveSheet.Shapes(1).Delete
    rngToPNG.Select
    ActiveWindow.DisplayGridlines = booGrid
    Application.ScreenUpdating = True

    ' Confirmation
    MsgBox "L'image a bien été enregistrée...", vbInformation
End If

End Sub
Rechercher des sujets similaires à "enregistrer plage image"