Discussion :

[coyote90]

Bonjour,

J'ai bien trouvé cette page qui explique comment exporter une plage en image.
Mais comment faire pour que cette images ait toujours la même taille en pixels ?

Le problème rencontré est lié aux écrans utilisés.
Si je fais l'export depuis l'écran de mon pc portable ou l'écran déporté, l'image finale n'a pas la même taille.

Si je demande à un collègue de faire l'export, l'image générée aura encore une autre taille.

Cette image doit être utilisée comme fond d'écran dans une autre application, et cette différence de taille / résolution finale pose problème.

Voici les dimensions finales du fichier jpg existant :
Largeur : 3596 pixels
Hauteur : 1249 pixels
Résolution Horizontale : 96 ppp
Résolution Verticale : 96 ppp
Profondeur de couleurs : 24

Merci d'avance pour votre aide et suggestions.

[Franc]

Bonjour, j'ai repris le code que tu as trouvé et ajouté quelques lignes pour spécifier les dimensions souhaitées, à tester.

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
48
49
50
51
52
53
54
55
56
57
Public Sub SaveRangeAsImage()
    Dim r As Range
    Dim x As Integer, y As Integer
    Dim varFullPath As Variant
    Dim Graph As String
 
    ' Sélection 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
    ' Utilisation de 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 graphique 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-papiers
    ActiveChart.Paste
    ' Redimensionnement
    ' On récupère le nom du graphique de la collection Shapes
    Graph = Mid(ActiveChart.Name, Len(ActiveSheet.Name) + 1)
    ' On effectue un redimensionnement
    Dim desiredWidth As Integer
    Dim desiredHeight As Integer
 
    ' Spécifier les dimensions souhaitées en pixels
    desiredWidth = 3596
    desiredHeight = 1249
 
    ' Calculer le facteur de redimensionnement
    Dim widthFactor As Double
    Dim heightFactor As Double
 
    widthFactor = desiredWidth / ActiveChart.ChartArea.Width
    heightFactor = desiredHeight / ActiveChart.ChartArea.Height
 
    ActiveSheet.Shapes(1).ScaleWidth widthFactor, msoFalse, msoScaleFromTopLeft
    ActiveSheet.Shapes(1).ScaleHeight heightFactor, 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

[coyote90]

C'est testé, et malheureusement la taille de l'image exportée reste différente selon l'écran sur lequel le fichier excel est affiché.