Exporter une plage de cellule en image
Bonjour à tous,
J'avais fait (en m'inspirant ici et là) une macro qui permet d'exporter une plage de cellule au format image, mais je viens de voir qu'elle ne redimensionne pas l'image à 700 pixels de large comme je le lui ai demandé... quelqu'un aurait une idée sur la façon de corriger ça?
Merci
Sub Export()
Application.ScreenUpdating = False
On Error GoTo ExportErreur
Dim Plage As Range
Dim FichierImage As Variant
Dim Titre As String
Titre = InputBox(Prompt:="Ajouter un titre à l'export ? (facultatif)")
Cells(2, 12) = Titre
Set Plage = Range("A2:W20").Cells
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
ActiveSheet.ChartObjects("ExportImage").Width = 700
ActiveSheet.ChartObjects("ExportImage").Height = 700 * Plage.Height / Plage.Width
FichierImage = Application.GetSaveAsFilename(InitialFileName:=Titre, FileFilter:="Image file (*.png), *.png")
If FichierImage <> False Then
ActiveSheet.ChartObjects("ExportImage").Chart.Export FichierImage
End If
ActiveSheet.ChartObjects("ExportImage").Delete
Cells(2, 12) = ""
Application.ScreenUpdating = True
Exit Sub
ExportErreur:
MsgBox "Une erreur est survenue..."
Application.ScreenUpdating = True
End SubAprès quelques tests supplémentaires il s'avère que les lignes
ActiveSheet.ChartObjects("ExportImage").Width = 700
ActiveSheet.ChartObjects("ExportImage").Height = 700 * Plage.Height / Plage.Width... font bien quelque chose. Si je modifie la valeur, la taille de l'image est modifiée en conséquence. Il y a un facteur 1,589 (700 ->1119) entre la taille demandée et la taille réelle (en ouvrant l'image dans un logiciel de traitement type Photoshop). C'est surement un truc lié à la résolution de mon écran ou quelque chose du genre.
Je vais faire un produit en croix pour obtenir la taille d'image voulue.
Merci à ceux qui ont passé du temps dessus, désolé
Bonjour,
Si j'ai bien compris, tu veux que l'image exportée soit à 700 pixels de large.
Il y a une différence entre les pixels Excel et les pixels-écrans.
Dans mon cas, le pixel-écran est 1,333333 plus petits.
Pour avoir 700 pixels-écrans, dans ton code, je dois modifier ainsi ...
ActiveSheet.ChartObjects("ExportImage").Width = 700 / 1.3333
ActiveSheet.ChartObjects("ExportImage").Height = (700 / 1.3333) * Plage.Height / Plage.Widthric