Bonjour a tous, voila mon problème.
J'ai un code qui extrait une plage de donnée dans des feuilles bien définies et qui créait des images en format JPEG.
Mon souci est qu'elles sont en format 4/3 et que j'ai besoin de les afficher sur des écrans en 16/9 .
Si je les mets sur ces écrans j'ai deux bandes noires de chaque cotés.
J'ai essayé de modifier les largeurs de colonnes mais rien à faire j'ai toujours une image en 4/3.
je mets mon code ci-dessous , si quelqu'un peux me donner une piste
par avance merci a vous
ActiveWorkbook.Save
Dim Plage As Range
Dim x As Byte
Dim Chemin As String
Dim wks As Worksheet
Chemin = ThisWorkbook.Path & "\" ' a adapter
For Each wks In ThisWorkbook.Worksheets
If Left(wks.Name, 4) = "plat" Then
x = x + 1
Set Plage = wks.Range("A1:I12")
NOM = Chemin & wks.Cells(1, 2).Value & ".jpeg"
Application.ScreenUpdating = False
DoEvents
Set Cht = Workbooks.Add(xlChart).Charts(1)
Cht.ChartArea.Clear
Plage.CopyPicture xlScreen, xlPicture
DoEvents
Do While Cht.Shapes.Count = 0
DoEvents
Cht.Paste
DoEvents
Loop
DoEvents
With Cht.Shapes(1)
.Left = 0
.Top = 0
.Width = Cht.ChartArea.Width
.Height = Cht.ChartArea.Height
End With
Cht.Export NOM, "PNG", False
Cht.Parent.Close False
End If
Next
ThisWorkbook.Save
DoEvents
ThisWorkbook.Close False
End Sub
J'ai un code qui extrait une plage de donnée dans des feuilles bien définies et qui créait des images en format JPEG.
Mon souci est qu'elles sont en format 4/3 et que j'ai besoin de les afficher sur des écrans en 16/9 .
Si je les mets sur ces écrans j'ai deux bandes noires de chaque cotés.
J'ai essayé de modifier les largeurs de colonnes mais rien à faire j'ai toujours une image en 4/3.
je mets mon code ci-dessous , si quelqu'un peux me donner une piste
par avance merci a vous
ActiveWorkbook.Save
Dim Plage As Range
Dim x As Byte
Dim Chemin As String
Dim wks As Worksheet
Chemin = ThisWorkbook.Path & "\" ' a adapter
For Each wks In ThisWorkbook.Worksheets
If Left(wks.Name, 4) = "plat" Then
x = x + 1
Set Plage = wks.Range("A1:I12")
NOM = Chemin & wks.Cells(1, 2).Value & ".jpeg"
Application.ScreenUpdating = False
DoEvents
Set Cht = Workbooks.Add(xlChart).Charts(1)
Cht.ChartArea.Clear
Plage.CopyPicture xlScreen, xlPicture
DoEvents
Do While Cht.Shapes.Count = 0
DoEvents
Cht.Paste
DoEvents
Loop
DoEvents
With Cht.Shapes(1)
.Left = 0
.Top = 0
.Width = Cht.ChartArea.Width
.Height = Cht.ChartArea.Height
End With
Cht.Export NOM, "PNG", False
Cht.Parent.Close False
End If
Next
ThisWorkbook.Save
DoEvents
ThisWorkbook.Close False
End Sub