Discussion :

[Fredooooo]

bon la j'y suis allé avec l'artillerie lourde si tu me dis que ca marche pas c'est que tu a un soucis avec tes librairies

ouvre un nouveau fichier
met lui un userform et un module classe que tu nommera allinOne
dans ton userform met tout plein de contrôles divers avec même un font différent en taille
dans le code du userform tu met
tu constatera que je t'ai prevu toutes les options

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
Dim cl As New allinOne
Private Sub CommandButton3_Click()
Unload Me
End Sub
Private Sub UserForm_Activate()
'fait ton choix et débloque la bonne ligne et bloque toute les autres
'cl.in_all_screen Me                            'on garde la caption et la barre des tache
'cl.in_all_screen Me, False                      'on vire la caption mais on garde la barre des tache
'cl.in_all_screen Me, False, False               'on vire la caption et la barre des tache
cl.in_all_screen Me, , False                    'on garde la caption mais on vire la barre des tache
 
End Sub
Private Sub UserForm_Initialize()
cl.init_usf Me
End Sub
Private Sub UserForm_Resize()
cl.sresize Me
End Sub

comme tu peut le voir il n'y pratiquement aucun code dans le userform
maintenant dans ton module classe "allinOne" tu met

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Private Declare Function GetSystemMetrics Lib "User32" (ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "User32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function FWA Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowRect Lib "User32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function ShowWindow Lib "User32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function DrawMenuBar Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function SWL Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const SM_CXSCREEN = 0    'Screen width
Private Const SM_CYSCREEN = 1    'Screen height
Private Const LOGPIXELSX = 88    'Pixels/inch in X
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
'A point is defined as 1/72 inches
Private Const POINTS_PER_INCH As Long = 72
Dim RW As Single, RH As Single
'The width of the screen, in pixels
Public Function ScreenWidth() As Long
    ScreenWidth = GetSystemMetrics(SM_CXSCREEN)
End Function
'The height of the screen, in pixels
Public Function ScreenHeight() As Long
    ScreenHeight = GetSystemMetrics(SM_CYSCREEN)
End Function
Function HeightBarre()
    Dim R As RECT, rectangle As Long, handletask As Long
    handletask = FWA("Shell_TrayWnd", "")    'on capte le handle de la taskbar
    rectangle = GetWindowRect(handletask, R)    'on créé un rectangle en memoire  correspondant au coordonées de la taskbar
    HeightBarre = ScreenHeight - R.Top
End Function
'The size of a pixel, in points
Public Function PointsPerPixel() As Double
    Dim hDC As Long
    Dim lDotsPerInch As Long
    hDC = GetDC(0)
    lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
    PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
    ReleaseDC 0, hDC
End Function
Function heightborder()
    heightborder = GetSystemMetrics(8)
End Function
'Ensuite Sur l'initialisation du formulaire
Sub init_usf(usf)
    RW = usf.Width
    RH = usf.Height
    For Each ctl In usf.Controls
        ctl.Tag = Round(ctl.Left, 2) & ":" & Round(ctl.Top, 2) & ":" & Round(ctl.Width, 2) & ":" & Round(ctl.Height, 2)
        If TypeName(ctl) <> "ScrollBar" And TypeName(ctl) <> "SpinButton" Then ctl.Tag = ctl.Tag & ":" & ctl.Font.Size
    Next
End Sub
Sub in_all_screen(usf, Optional captions As Boolean = True, Optional tasks As Boolean = True)
    Dim handle As Long
    handle = FWA(vbNullString, usf.Caption)
    'si captions = False on la retire
    If captions = False Then SWL handle, -16, &H94080080: SWL handle, -20, 0: DrawMenuBar handle
    'si task=true on garde la taskbar
    Select Case tasks
    Case True
        'Calcule le rapport de l'UserForm et la taille de l'écranusf.Width = ScreenWidth * PointsPerPixel - heightborder
        usf.Height = (ScreenHeight * PointsPerPixel) - (HeightBarre * PointsPerPixel) - (heightborder * 2)
        usf.Width = (ScreenWidth * PointsPerPixel) - IIf(captions, (heightborder * 2), 0)
        usf.Top = 0: usf.Left = 1
    Case False
        ShowWindow handle, 3
    End Select
End Sub
Sub sresize(usf)
    Dim RW2, RH2
    RW2 = usf.Width / RW
    RH2 = usf.Height / RH
    For Each ctl In usf.Controls
        dims = Split(ctl.Tag, ":")
        ctl.Move dims(0) * RW2, dims(1) * RH2, dims(2) * RW2, dims(3) * RH2
        If TypeName(ctl) <> "ScrollBar" And TypeName(ctl) <> "SpinButton" Then ctl.Font.Size = dims(4) * RW2
    Next
End Sub

voila comment est mon userform a la base
Pièce jointe 203842

voila le résultat en gardant la 3 Emme option dans le userform
Pièce jointe 203843

Wagadougouh!!!!!

Bonjour,

Je viens d'essayer votre code pour mon application et cela ne fonctionne pas et je ne comprends pas d'ou vient le problème.

Ci-joint mon fichier .

Merci d'avance

[Pierre Fauconnier]

Salut.

Si vous avez des questions relatives au redimensionnement de contrôles et/ou de userform, merci de poser vos questions sur une nouvelle discussion.