Discussion :

[Many31]

Bonjour le fofo,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Didpa]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[ucfoutu]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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é

@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