Bonjour,

cette procédure permet de sauvegarder sous forme de fichier GIF, une plage de cellules d'une feuille Excel.
On utilise un objet graphique temporaire, car il est très facile d'exporter une image à partir d'un Chart.

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
40
41
42
43
44
45
46
47
Public Sub SaveRangeAsImage()
 
Dim r As Range
Dim x As Integer, y As Integer
Dim varFullPath As Variant
Dim Graph As String
 
' selection de la plage par une InputBox
Set r = application.InputBox("Sélectionnez la plage à exporter", _
                    "Export Image", Selection.AddressLocal, Type:=8)
 
r.Select
' copie de la plage en format image grâce à .CopyPicture
Selection.CopyPicture appearance:=xlScreen, Format:=xlBitmap
x = Selection.Width
y = Selection.Height
 
' on utilise l'objet Chart pour sa facilité d'export 
' création du graphique
Workbooks.Add (1)
ActiveSheet.Name = "enGIF"
Charts.Add
ActiveChart.ChartType = xl3DArea
ActiveChart.SetSourceData r
ActiveChart.Location xlLocationAsObject, "enGIF"
' le graph n'est là que comme réceptacle de l'image, on le vide avec .ClearContents
ActiveChart.ChartArea.ClearContents
' on colle l'image qui réside dans le presse papier
ActiveChart.Paste
 
' redimensionnement
' on récupére le nom du graph de la collection Shapes
Graph = Mid(ActiveChart.Name, Len(ActiveSheet.Name) + 1)
' on effectue un redimensionnement
ActiveSheet.Shapes(Graph).ScaleWidth x / ActiveChart.ChartArea.Width, _
            msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes(Graph).ScaleHeight y / ActiveChart.ChartArea.Height, _
            msoFalse, msoScaleFromTopLeft
 
' export
varFullPath = application.GetSaveAsFilename("C:\Temp\export-" & Format(Now, "yyyymmddhhnn") & ".gif", _
                "Fichiers GIF (*.gif), *.gif")
ActiveChart.Export varFullPath, "GIF"
ActiveChart.Pictures(1).Delete
ActiveWorkbook.Close False
 
End Sub