Redimensionnement d'un userform

[Troudz]

Bonjour tout le monde,

Depuis deux jours, j'essaye de trouver la meilleure méthode pour adapter la taille de plusieurs userform à la résolution de différents écrans. Pour cela, j'ai trouvé deux très bonnes méthodes que j'essaye de compiler mais sans succés.

La première (celle de Patrick toulon) est parfaite à ceux - ci près : la taille des caractères n'est pas correctement ajustée pour toutes les résolutions et les proportions entre les différentes tailles ne sont pas respectées.
La seconde fait ça très bien mais le code est difficilement compréhensible, ne fait pas apparaître les trois boutons dans la barre de titre, nécessite de copier beaucoup de code dans chaque userform...

J'aimerai arriver à modifier la gestion des font size utilisées dans la première en la remplaçant par le code utilisé dans la seconde :

If Int(hFactor) > 0 Then
    Ctl.Font.Size = Int(hFactor * frmControl(Idx).SizeFont)
Else
    Ctl.Font.Size = frmControl(Idx).SizeFont
End If

Seulement là je bloque grave. Impossible de comprendre à quoi correspondent ces frmControl(Idx), hfactor... et comment sont elles calculées.

Est ce que quelqu'un aurait une idée ? Un début de piste ?

Je vous remercie par avance de votre aide.

 

[fhoest]

Re : Redimensionnement d'un userform

Bonjour,
je trouve les fichiers super,il y en a qui sont vraiment très fort,
mais lorsque je regarde comment les interfaces en général sont faits lors d'un changement de taille d'une fenêtre les tailles des contrôles ne changent pas idem pour le texte.
Fait un test sur ton appli internet tu verra ce que je veux dire,
je pense que lorsque l'on développe on ne doit pas toucher a la hauteur du texte et la hauteur des autres contrôles,
je sais que ça n'avance pas beaucoup ton problème,mais bon cela peu peut être aider a réfléchir au adaptations de taille de fenetre


Pour le code

hfactor est declarer comme entier (integer)
'le fait qu'il soit calculer plus haut dans le code par une division
tu peux obtenir un nombre decimale
de ce fait tu prend uniquement l'entier par la fonction INT()
car hfactor=entier
If Int(hFactor) > 0 Then
le ctl=control .font=ecriture(texte) . size=taille *=fois frmcontrol(idx)=form control idx=index du control)    etc...
Ctl.Font.Size = Int(hFactor * frmControl(Idx).SizeFont)
Else
    Ctl.Font.Size = frmControl(Idx).SizeFont
End If

A+

 

[Troudz]

Re : Redimensionnement d'un userform

Effectivement ça ne m'avance pas beaucoup !

Je vois très bien ce que tu veux dire mais, si je cherche à adapter la taille de mes contrôles, c'est bien que ça me serait utile.
Si je ne la réduit pas, mes contrôles vont se monter les uns sur les autres lors du redimensionnement. Et si je ne les agrandit pas, je ne profiterai pas d'une lisibilité max sur des grands écrans.

J'ai bien compris comment es calculé ce HFactor mais le frmControl(Idx) reste un mystère. On s'en sert pour donner une nouvelle valeur à Ctl.Font.Size mais je ne vois pas à quelle valeur ça correspond.

 

[PMO2]

Re : Redimensionnement d'un userform

Bonjour,

Pour ce qui concerne la méthode 2

La seconde fait ça très bien mais le code est difficilement compréhensible, ne fait pas apparaître les trois boutons dans la barre de titre

voici un code modifié

Private Sub UserForm_Initialize()
  Const GWL_STYLE = (-16)
  Const GWL_EXSTYLE = (-20)
  Const WS_SIZEBOX = &H40000
  Const WS_EX_APPWINDOW = &H40000
  
  Const WS_MAXIMIZEBOX = &H10000  '/// ajout
  Const WS_MINIMIZEBOX = &H20000  '/// ajout
  
  Dim hwnd As Long, wLong As Long
  wForm = Me.Width: hForm = Me.Height
  hwnd = FindWindow(vbNullString, Me.Caption)
  wLong = GetWindowLongA(hwnd, GWL_EXSTYLE)
  wLong = wLong Or WS_EX_APPWINDOW
  SetWindowLong hwnd, GWL_EXSTYLE, wLong
  wLong = GetWindowLongA(hwnd, GWL_STYLE)
  
  wLong = wLong Or WS_SIZEBOX Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX '/// modif
  
  SetWindowLong hwnd, GWL_STYLE, wLong
  Call lblResize
  Call SaveControlsProperties
End Sub

Cordialement.

PMO
Patrick Morange

 

[Troudz]

Re : Redimensionnement d'un userform

Merci d'apporter ta pierre à l'édifice Patrick.
Cela dit j'aimerai vraiment utiliser le redimensionnement des polices de la méthode 2 :

If Int(hFactor) > 0 Then
    Ctl.Font.Size = Int(hFactor * frmControl(Idx).SizeFont)
Else
    Ctl.Font.Size = frmControl(Idx).SizeFont
End If

dans la méthode 1. Mais j'avoue que je ne comprend rien aux propriétés InsideHeight utilisées.

 

[fhoest]

Re : Redimensionnement d'un userform

Bonsoir,
le code défini une structure type

Private Type Ctrl_Struct
  Name As String
  Index As Long
  Top As Long
  Left As Long
  Height As Long
  Width As Long
  NParent As String
  SizeFont As Integer
  CountColumn As Byte
  WidthColumn As String
End Type


Private frmControl() As Ctrl_Struct

le private frmcontrole(idx).type de structure et redimensionner a cette endroit

[COLOR="red"]Private Sub SaveControlsProperties()[/COLOR]
  Dim CtlParent As Object, Ctl As Object, Idx As Integer, iFlag As Boolean
  Dim ListInfo() As String, i As Integer, w As Integer
  
  Do
    Set Ctl = Me.Controls.Item(Idx)
    ReDim Preserve frmControl(0 To Idx)
    frmControl(Idx).Top = Ctl.Top
    frmControl(Idx).Index = Idx
    frmControl(Idx).Left = Ctl.Left
    frmControl(Idx).Name = Ctl.Name
    frmControl(Idx).Width = Ctl.Width
    frmControl(Idx).Height = Ctl.Height
    On Error Resume Next
    [COLOR="red"]frmControl(Idx).SizeFont = Ctl.Font.Size[/COLOR]

en fait tu viens remplacer la valeur .font.size du contrôle par le sizefont déclarer dans la structure,tu viens placer chaque propriété du contrôle dans un tableau
peut être je me trompe car je ne suis pas programmeur,mais c'est ce que je pense en essayant de comprendre le code.

A+

 

[laetitia90]

Re : Redimensionnement d'un userform

bonjour tous
tu peus peut être essayer simplement comme cela ????

 

[laetitia90]

Re : Redimensionnement d'un userform

re,
version 3 boutons de Patrick toulon

 

[fhoest]

Re : Redimensionnement d'un userform

Bonjour,
je n'ai qu'une chose a ajouter
@ Laetttia90 """BBBRRRAAAVVVOOO"""
Simple code et efficace.
A bientôt.

 

[laetitia90]

Re : Redimensionnement d'un userform

bonjour Troudz , PMO2 , fhoest

toujours sur la version 3 boutons de Patrick toulon mais avec variable public si beaucoup d'userforms
je "libere" pas l'object user a chaque fermeture d'userform peut être utile de le faire a reflechir !!!

 

[Troudz]

Re : Redimensionnement d'un userform

C'est prodige !

Merci beaucoup Laetitia !
Je n'avais pas réussi à l'adapter aussi bien.
En plus le bug qui décalait un poil certains contrôles à chaque redimensionnement a disparu.
Et puis avec ton code au moins, je comprend tout.

Un immense merci Laetitia !

Bonne fin de week end à tous !

 

[Troudz]

Re : Redimensionnement d'un userform

Petite question subsidiaire Laetitia :

En fait j'avais besoin de cette macro pour un userform qui ne s'affiche pas complètement avec une résolution inférieure à 1280 x 1024. Du coup j'ai modifié un tout petit peu ton code pour que, dans le cas d'une résolution inférieure, le userfor s'affiche en plein écran.
J'ai utilisé pour cela le code :

If GetSystemMetrics(0) < 1280 Or GetSystemMetrics(1) < 1024 Then
    user.Width = Application.Width - 5: user.Height = Application.Height - 5
End If

Mon soucis est qu'une fois passé en plein écran, dans la barre de titre du userform, on peut encore passé en plein écran "total" avec le bouton du milieu.

Y aurait il moyen de "simuler" un clic sur ce bouton avec du code vba ?
Je reconnais que ça aura quasiment le même effet mais ça me titille quand même.

 

[laetitia90]

Re : Redimensionnement d'un userform

bonjour tous.... comme je comprends???

 

[laetitia90]

Re : Redimensionnement d'un userform

re, tous.... en fin de compte on peus simplifier
du moment qu'on a hWnd on peut se passer de handle
dans tout les cas ces 2 api indispensable

Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

mais pour le reste

Sub yy()
handle = FindWindow("Thunder" & IIf(Application.Version Like "8*", "0*", "D") & "Frame", user.Caption)
If GetSystemMetrics(0) > 1280 Or GetSystemMetrics(1) < 1024 Then ShowWindow handle, 3
End Sub

devient

Sub yy()
If GetSystemMetrics(0) < 1280 Or GetSystemMetrics(1) < 1024 Then ShowWindow hWnd, 3
End Sub

bien sur dans chaque userform en fonction de tes besoins
il faut ajouter

Private Sub UserForm_Activate()
yy
End Sub

qui appel la variable public yy avec ses conditions

 

[Troudz]

Re : Redimensionnement d'un userform

Merci Laetitia mais la procédure "yy" ne fait rien du tout.
Elle se déclenche bien mais rien ne se passe.

En fait ce que je voudrais, c'est que si la résolution est inférieure à 1280 x 1024, mettre le userform en plein écran comme si l'utilisateur avait cliqué lui même sur le bouton du milieu dans la barre de titre.