export d'un range en image - taille et définition prédéfinie.

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.

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

Code:

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

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é.