Discussion :

[Alias_2003]

Bonjour à tous,
Mon post fait suite à la contribution de Patricktoulon concernant le redimensionnement des contrôles dans un userform. Patrick a eu la gentillesse d'adapter son code à une de mes demandes (merci encore à lui). J'utilise donc son fichier pour vous poser une nouvelle question : dans le fichier joint, j'aimerais savoir s'il est possible de d'adapter la taille du label1 à son contenu (variable puisque dépendant du contenu de la cellule A1), puis de positionner la combobox1 accolée à ce label1.
Merci beaucoup de vos réponses,
Bonne journée,
Amicalement

[Alias_2003]

Re-,
je me réponds à moi-même : j'ai pu me débrouiller en mettant la propriété autosize de mon label à true.
Bonne journée à tous

[Alias_2003]

Bonjour à tous,
je ré-ouvre cette question que je pensais résolue...
Ci-dessous le fichier créé par patrciktoulon et que j'ai modifié pour arriver à mes fins.
Le soucis est que le caption et donc la taille du label1 étant variable, je ne parviens pas à récupérer sa largeur...
Merci beaucoup par avance de votre aide,
Amicalement

[Alias_2003]

Bonjour à tous,
Personne n'a d'idée ? Je me permets de vous donner ci dessous le code du module de classe utilisé lors du redimensionnement de l'userform (merci encore patricktoulon) que j'ai modifié et qui ne donne pas le résultat voulu...

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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
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
 
    usf.Label1.AutoSize = True
    usf.Label1.Caption = "blablablablbalab " & Feuil1.Range("A1") & " blablablablablabla "
    LargLabel1 = usf.Label1.Width
    For Each ctl In usf.Controls
 
        If ctl.Name <> "Label1" Then
            ctl.Tag = Round(ctl.Left, 2) & ":" & Round(ctl.Top, 2) & ":" & Round(ctl.Width, 2) & ":" & Round(ctl.Height, 2)
        Else
            ctl.Tag = Round(ctl.Left, 2) & ":" & Round(ctl.Top, 2) & ":" & Round(LargLabel1, 2) & ":" & Round(ctl.Height, 2)
        End If
        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
    Dim gauche As Long, haut As Long
    RW2 = usf.Width / RW
    RH2 = usf.Height / RH
    For Each ctl In usf.Controls
        If ctl.Name <> "ComboBox1" Then
        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
        If ctl.Name = "Label1" Then
            gauche = dims(2) * RW2 + dims(0) * RW2 + 20
            haut = dims(1) * RH2 + (dims(3) * RH2) / 2
        End If
        End If
    Next
    UserForm.ComboBox1.Left = gauche
    UserForm.ComboBox1.Top = haut
End Sub

Si l'un d'entre vous a une piste...
Merci beaucoup,
Amicalement