Redimensionner un Userform

Version imprimable

Bonjour le fofo,

Voilà en cherchant à droite à gauche j'ai adapté un code pour redimensionner un Userform lors de son lancement:

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
 
Public Declare Function FindWindowA Lib "user32" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long '
Public Declare Function GetWindowLong Lib "user32" Alias _
        "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
 
Function ResizeUserForm(UForm As Object)
Dim hwnd As Long, exlong As Long, factor As Integer, zfactor As Integer
Dim UCaption As String
 
UCaption = UForm.Caption
hwnd = FindWindowA(vbNullString, UCaption)
exlong = GetWindowLong(hwnd, -16)
 
        zfactor = 1000 * (Application.Width / (UForm.Width + 20))
        factor = 1000 * (Application.Height / (UForm.Height + 20))
 
If factor < 1000 Then
    PrAc = CInt(((1000 - factor) / factor) * 100 + 1)
    Zoom = 100 + PrAc
UForm.Width = UForm.Width / (Zoom / 100)
UForm.Height = UForm.Height / (Zoom / 100)
If PrAc > 5 Then
    UForm.Zoom = 200 - (Zoom - 5)
Else
    UForm.Zoom = 200 - Zoom
End If
End If
If zfactor < 1000 Then
'rien pour l'instant
 
End If
End Function

Seul soucis, le code s'applique selon la taille de la fenêtre de l'application Excel et non celle de la résolution de l'écran.

Quelqu'un aurait une idée?

Merci

Redimensionner un Userform

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Option Explicit
Private Declare Function FindWindowA Lib "User32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
 
 
Private Sub UserForm_Initialize()
  Dim hWnd As Long, exLong As Long, zFactor As Integer
 
  hWnd = FindWindowA(vbNullString, Me.Caption)
  exLong = GetWindowLongA(hWnd, -16)
  If exLong And &H880000 Then SetWindowLongA hWnd, -16, exLong And &HFF77FFFF
  zFactor = 100 * CInt(Application.Width / Me.Width)
  Me.Width = Application.Width
  Me.Height = Application.Height
 
End Sub

Bonjour,

Je ne suis pas certain d'avoir bien compris ce que tu cherches à faire.
Il me semble que tu cherches à adapter les dimensions de ton userform en fonction de celles de l'écran d'exécution.
Si tel est bien le cas, il te suffit de déterminer les dimensions de l'un et de l'autre dans la même unité (nous allons par exemple ici choisir les pixels) et d'en déduire un coefficient k "correcteur" à appliquer à ton UserForm.
Mais je me dis également que ton problème peut finalement être autre, que tu cherches au bout du compte à ne réajuster les dimensions de ton userform que lorsque les dimensions de l'écran final sont différentes de celles de l'écran de création. Si tel est le cas, la méthode la plus simple est d'écrire dans ton code, en dur, les largeur et hauteur de ton écran (de création, donc) et de comparer, en mode exécution, avec les hauteur et largeur de l'écran final. Tu peux ainsi en déduire les 2 coefficients kl et kh à appliquer aux dimensions de ton userform pour l'adapter à celles de l'écran final.
J'espère que tu comprends ce que j'expose ici.

Il te reste, dans tous les cas de figure, à savoir comment t'y prendre pour relever ces dimensions en mode exécution.
Voiici un exemple. Tu y prendras ce qui t'est utile en fonction du but à atteindre.
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 Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Const ENUM_CURRENT_SETTINGS As Long = -1& Const CCDEVICENAME = 32 Const CCFORMNAME = 32 Private Type DEVMODE dmDeviceName As String * CCDEVICENAME dmSpecVersion As Integer dmDriverVersion As Integer dmSize As Integer dmDriverExtra As Integer dmFields As Long dmOrientation As Integer dmPaperSize As Integer dmPaperLength As Integer dmPaperWidth As Integer dmScale As Integer dmCopies As Integer dmDefaultSource As Integer dmPrintQuality As Integer dmColor As Integer dmDuplex As Integer dmYResolution As Integer dmTTOption As Integer dmCollate As Integer dmFormName As String * CCFORMNAME dmUnusedPadding As Integer dmBitsPerPel As Integer dmPelsWidth As Long dmPelsHeight As Long dmDisplayFlags As Long dmDisplayFrequency As Long End Type Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean Private Declare Function CopyRect Lib "user32" (lpDestRect As RECT, lpSourceRect As RECT) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Sub Command1_Click() Dim DevM As DEVMODE, rectWindow As RECT, rectCopy As RECT, monhwnd As Long Call EnumDisplaySettings(0&, ENUM_CURRENT_SETTINGS, DevM) monhwnd = FindWindow(vbNullString, Me.Caption) GetWindowRect monhwnd, rectWindow CopyRect rectCopy, rectWindow MsgBox "largeur de l'userform:" + Str$(rectCopy.Right - rectCopy.Left) + " pixels" & vbCrLf & _ "hauteur de l'userform:" + Str$(rectCopy.Bottom - rectCopy.Top) + " pixels" & vbCrLf & _ "SANS LES BORDURES" & vbCrLf & "Quant à ton écran, il mesure " & DevM.dmPelsWidth & " pixels (de large)=" & " par " & DevM.dmPelsHeight & " pixels (de haut)" End Sub

22/10/2009, 13h13
Many31

Désolé pour le silence radio... J'ai eu quelques soucis de connexion et de mdp...

Merci Ucfoutu, c'est bien la taille de l'écran que je recherche... dans le code que j'avais, je prenais en compte la taille de la fenêtre d'execution Excel. Et si la personne avait redimensionné sa fenêtre avant de lancer l'Userform le rendu était très... moche

Je vais essayé avec les indices que tu m'as donné :P

@Didpa: je n'ai en rien compris ton intervention :? une rapide lecture du code que tu mets, force l'Userform à prendre la taille de la fenêtre Excel... ce qui peut s'avérer très moche. De plus tel quel la variable zfacteur n'est pas exploitée