Affichage plein écran d'un Userform contenant des images .gif

Messages postés
32
Date d'inscription
vendredi 31 juillet 2009
Statut
Membre
Dernière intervention
17 février 2015
-
Bonjour,

Je suis sur excel 2007, et j'ai un souci avec un userform.

Sur ma feuille de calcul, j'ai des données, pour lesquelles j'ai des graphiques. Ces graphiques s'affiche dans un Userform (qui contient un multipage, qui lui même contient les images en .gif des graphiques.

Pour les insérer dans le Userform, je créer un fichier temporaire en .gif, que j'injecte ensuite dans le multipage du Userform (chaques pages du multiforme à sa feuilles de calculs correspondantes.

jusque la pas de souci ca fonctionne.


Mon souci est que je voudrais que mon userform (qui contient un multipage qui lui même contient des images en .gif) s'affiche en pleine écran en s'ajustant à la résolution et taille de l'écran.

cela implique que le Userform se redimensionne sur la taille de l'écran,
que le multipage également, ainsi que les images en .gif (qui justement pose problème pour les redimensionner)

(sur chaques pages du multipage, il y a entre 4 et 5 graphiques)

Pour créer mes images en .gif, j'utilise le code suivant:

Sub MetLimage()
'Procédure MetLimage, pour insérer les graphiques dans un Userform (ici un multipage)

'CR'
Set LeGraph = Worksheets("CR").ChartObjects(1).Chart
NomImage = ThisWorkbook.Path & Application.PathSeparator & "temp.gif"
Set LeGraph2 = Worksheets("CR").ChartObjects(2).Chart
NomImage2 = ThisWorkbook.Path & Application.PathSeparator & "temp2.gif"
Set LeGraph3 = Worksheets("CR").ChartObjects(3).Chart
NomImage3 = ThisWorkbook.Path & Application.PathSeparator & "temp3.gif"
Set LeGraph4 = Worksheets("CR").ChartObjects(4).Chart
NomImage4 = ThisWorkbook.Path & Application.PathSeparator & "temp4.gif"
Set LeGraph5 = Worksheets("CR").ChartObjects(5).Chart
NomImage5 = ThisWorkbook.Path & Application.PathSeparator & "temp5.gif"


LeGraph.Export Filename:=NomImage, FilterName:="GIF"
LeGraph2.Export Filename:=NomImage2, FilterName:="GIF"
LeGraph3.Export Filename:=NomImage3, FilterName:="GIF"
LeGraph4.Export Filename:=NomImage4, FilterName:="GIF"
LeGraph5.Export Filename:=NomImage5, FilterName:="GIF"



UserForm1.MultiPage1.Pages(0).Image1.Picture = LoadPicture(NomImage)
UserForm1.MultiPage1.Pages(0).Image2.Picture = LoadPicture(NomImage2)
UserForm1.MultiPage1.Pages(0).Image3.Picture = LoadPicture(NomImage3)
UserForm1.MultiPage1.Pages(0).Image4.Picture = LoadPicture(NomImage4)
UserForm1.MultiPage1.Pages(0).Image5.Picture = LoadPicture(NomImage5)

Kill (NomImage) 'Supprime le fichier image.gif Temporaire
Kill (NomImage2) 'Supprime le fichier image.gif Temporaire
Kill (NomImage3) 'Supprime le fichier image.gif Temporaire
Kill (NomImage4) 'Supprime le fichier image.gif Temporaire
Kill (NomImage5) 'Supprime le fichier image.gif Temporaire


'AC'
Set LeGraph7 = Worksheets("AC").ChartObjects(1).Chart 'ChartObjects(1) fait référence au premier ChartObject de la feuille et pas à sa propriété Name)
NomImage7 = ThisWorkbook.Path & Application.PathSeparator & "temp7.gif"
Set LeGraph8 = Worksheets("AC").ChartObjects(2).Chart
NomImage8 = ThisWorkbook.Path & Application.PathSeparator & "temp8.gif"
Set LeGraph9 = Worksheets("AC").ChartObjects(3).Chart
NomImage9 = ThisWorkbook.Path & Application.PathSeparator & "temp9.gif"
Set LeGraph10 = Worksheets("AC").ChartObjects(4).Chart
NomImage10 = ThisWorkbook.Path & Application.PathSeparator & "temp10.gif"

LeGraph7.Export Filename:=NomImage7, FilterName:="GIF"
LeGraph8.Export Filename:=NomImage8, FilterName:="GIF"
LeGraph9.Export Filename:=NomImage9, FilterName:="GIF"
LeGraph10.Export Filename:=NomImage10, FilterName:="GIF"

UserForm1.MultiPage1.Pages(1).Image7.Picture = LoadPicture(NomImage7)
UserForm1.MultiPage1.Pages(1).Image8.Picture = LoadPicture(NomImage8)
UserForm1.MultiPage1.Pages(1).Image9.Picture = LoadPicture(NomImage9)
UserForm1.MultiPage1.Pages(1).Image10.Picture = LoadPicture(NomImage10)

Kill (NomImage7) 'Supprime le fichier image.gif Temporaire
Kill (NomImage8) 'Supprime le fichier image.gif Temporaire
Kill (NomImage9) 'Supprime le fichier image.gif Temporaire
Kill (NomImage10) 'Supprime le fichier image.gif Temporaire

'BE'

Set LeGraph11 = Worksheets("BE").ChartObjects(1).Chart 'ChartObjects(1) fait référence au premier ChartObject de la feuille et pas à sa propriété Name)
NomImage11 = ThisWorkbook.Path & Application.PathSeparator & "temp11.gif"
Set LeGraph12 = Worksheets("BE").ChartObjects(2).Chart
NomImage12 = ThisWorkbook.Path & Application.PathSeparator & "temp12.gif"
Set LeGraph13 = Worksheets("BE").ChartObjects(3).Chart
NomImage13 = ThisWorkbook.Path & Application.PathSeparator & "temp13.gif"
Set LeGraph14 = Worksheets("BE").ChartObjects(4).Chart
NomImage14 = ThisWorkbook.Path & Application.PathSeparator & "temp14.gif"

LeGraph11.Export Filename:=NomImage11, FilterName:="GIF"
LeGraph12.Export Filename:=NomImage12, FilterName:="GIF"
LeGraph13.Export Filename:=NomImage13, FilterName:="GIF"
LeGraph14.Export Filename:=NomImage14, FilterName:="GIF"


UserForm1.MultiPage1.Pages(2).Image11.Picture = LoadPicture(NomImage11)
UserForm1.MultiPage1.Pages(2).Image12.Picture = LoadPicture(NomImage12)
UserForm1.MultiPage1.Pages(2).Image13.Picture = LoadPicture(NomImage13)
UserForm1.MultiPage1.Pages(2).Image14.Picture = LoadPicture(NomImage14)

Kill (NomImage11) 'Supprime le fichier image.gif Temporaire
Kill (NomImage12) 'Supprime le fichier image.gif Temporaire
Kill (NomImage13) 'Supprime le fichier image.gif Temporaire
Kill (NomImage14) 'Supprime le fichier image.gif Temporaire

End Sub



Pour afficher mon Userform en plein écran, j'utilise le code suivant:

Dans un module.

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Const GWL_STYLE = (-16), GWL_EXSTYLE = (-20), WS_SIZEBOX = &H40000, WS_TROIS_BOUTON = &H70000, WS_EX_APPWINDOW = &H40000
Public l(), h(), f(), p(), s() As String, wLong As Long, hWnd As Long, i, c As Control, la As Long, ha As Long
Public user As Object
Sub es()
On Error Resume Next
i = 0: ha = user.Height: la = user.Width
For Each c In user.Controls

i = i + 1
ReDim Preserve l(i): l(i) = c.Width
ReDim Preserve h(i): h(i) = c.Height
ReDim Preserve p(i): p(i) = c.Top
ReDim Preserve f(i): f(i) = c.Left
ReDim Preserve s(i): s(i) = c.Width / c.Font.Size
Next
hWnd = FindWindow(vbNullString, user.Caption)
wLong = GetWindowLongA(hWnd, GWL_STYLE) Or WS_SIZEBOX Or WS_TROIS_BOUTON
SetWindowLong hWnd, GWL_STYLE, wLong
ShowWindow hWnd, 3 'plein ecran a ouverture
End Sub
Sub zz()
On Error Resume Next
i = 0
For Each c In user.Controls
i = i + 1
c.Width = user.Width / (la / l(i))
c.Height = user.Height / (ha / h(i))
c.Left = user.Width / (la / f(i))
c.Top = user.Height / (ha / p(i))
c.Font.Size = c.Width / s(i)
Next
End Sub
Afficher la suite