Positionnement de contrôles par rapport à une userform

**LaureneW** · 12/03/2019, 15h19

Bonjour à tous !
Je rencontre un problème pour le positionnement d'une userform sur Excel, je vais essayer d'être claire :
j'ai une userform qui contient un multipage (qui fait la même taille que la userform). J'ai 11 pages, avec sur chacune, des cadres (ou Frame), des labels, des TextBox, des boutons de commandes.
Mon problème c'est que l'excel peut être ouvert sur différents ordis. Pour ça, ma userform et mon multipage sont dimensionnés de sorte qu'ils s'adaptent à différentes résolutions d'écran (la userform s'affiche en plein écran).

Je cherche donc à positionner tous mes contrôles (présents sur les différentes pages) en fonction des dimensions de ma userform (ou de mon multipage).
Un exemple vaut mieux que de longues phrases donc :
"j'aimerai que la position de mon Frame1 soit à une distance de 10 du bord gauche de ma userform" ou encore " mon textBox1 soit à une distance de 30 de ma userform"

Quand je change les propriétés Left ou Top de mes contrôles, ceux ci se déplacent mais si je change d'écran, ils vont rester en position 600 par exemple et donc n'apparaissent plus sur l'écran...

Merci pour l'aide !

**patricktoulon** · 14/03/2019, 16h39

re
tu le met en plein ecran comment?

un petit exemple sans api et autre cochonnerie niveau compréhension (debutant )

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
Dim WW As Double
Dim HH As Double
Dim wste As Double
Private Sub CommandButton1_Click() 'affichage maximisé
   wste = Application.WindowState
   Application.WindowState = xlMaximized
    With Me
        .Height = Application.Height - 15
        .Width = Application.Width - 6
        .Top = 0
        .Left = 0
    End With
Me.Show 0
End Sub
Private Sub CommandButton2_Click() 'affichage normal
With Me: .Width = WW: .Height = HH: .Show 0: End With
End Sub
 
Private Sub UserForm_Initialize()
    WW = Me.Width: HH = Me.Height
    For Each ctrl In Me.Controls
        ctrl.Tag = ctrl.Tag & ctrl.Top & ";" & ctrl.Left & ";" & ctrl.Width & ";" & ctrl.Height
        'Debug.Print ctrl.Name & "---" & ctrl.Tag
    Next
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.WindowState = wste
End Sub
Private Sub UserForm_Resize()
    Dim newW#, newH#
    newH = Me.Height / HH: newW = Me.Width / WW
    For Each ctrl In Me.Controls
        'Debug.Print ctrl.Name & "---" & ctrl.Tag
        tbl = Split(ctrl.Tag, ";")
        'replacement(non facultatif)
        ctrl.Top = tbl(0) * newH
        ctrl.Left = tbl(1) * newW
        'redimentionnement(facultatif)pour tous sauf les conteneurs
        'If TypeName(ctrl) = "MultiPage" Or TypeName(ctrl) = "Frame" Then
        ctrl.Height = tbl(3) * newH
        ctrl.Width = tbl(2) * newW
        'End If
    'si on ne veut redimentionner que les conteneur (frame,multipage) on debloque les ligne vertes
    Next
End Sub

**LaureneW** · 14/03/2019, 16h43

Hello,
Par ce code là :

Code :

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

1
2
3
4
5
Me.Width = ScreenWidth * PointsPerPixel
    Me.Height = ScreenHeight * PointsPerPixel
 
    MultiPage1.Height = ScreenHeight * PointsPerPixel
    MultiPage1.Width = ScreenWidth * PointsPerPixel

**patricktoulon** · 14/03/2019, 16h48

re
ces fonctions n'existent pas en vba il faut les créer

**MarcelG** · 14/03/2019, 16h54

Salut Laurene, Salut Patricck,

Sans vouloir polluer la discussion.

Voici ce que j'utilise

Module standard.

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
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Const SW_MAXIMIZE = 3
 
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0 'Screen width
Private Const SM_CYSCREEN = 1 'Screen height
 
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 Const LOGPIXELSX = 88 'Pixels/inch in X
'
'A point is defined as 1/72 inches
Private Const POINTS_PER_INCH As Long = 72
 
Declare Function GetSystemMetrics32 Lib "user32" _
Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
 
'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
 
'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

A l'initialisation du formulaire.

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
Private Sub UserForm_Initialize()
 
'If Is_Marcel Then GoTo lasuite
 
'Empêcher croix de fermeture
Dim hwnd As Long
hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") & "Frame", Me.Caption)
SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
 
'-------------------------------------------------------------
'Déclaration des variables RX et RH
Dim RW As Single, RH As Single
 
'Calcule le rapport de l'UserForm et la taille de l'écran
RW = 0.98 * ScreenWidth * PointsPerPixel / Me.width
RH = 0.98 * ScreenHeight * PointsPerPixel / Me.height
'Debug.Print RW
'Debug.Print RH
 
'Met l'UserForm en plein écran
Me.width = 0.98 * ScreenWidth * PointsPerPixel
Me.height = 0.98 * ScreenHeight * PointsPerPixel
 
'Déclaration de la variable Ctl qui correspond aux contrôles de ton UserForm
Dim Ctl As MSForms.Control
 
'Call déclare_couleurs
 
'Permet de redimensionner tous tes contrôles présent sur l'UserForm en fonction de la taille de l'userForm et de la taille de l'écran
For Each Ctl In Me.Controls
 
        With Ctl
 
                .Move .left * RW, .top * RH, .width * RW, .height * RH
                'If TypeOf Ctl Is MSForms.TextBox Or TypeOf Ctl Is MSForms.Label Then
                        'Ajuste la taille de police
                        With .Font
                                .Size = .Size * RW / RH * 1.5
                        End With
                'End If
                'Debug.Print .Name
        End With
 
 
Next Ctl
 
   'Pour garder l'userform au 1er plan
   'SetWindowPos FindWindowA("ThunderDFrame", Me.Caption), _
     -1, 0, 0, 0, 0, 3

Surtout! Surtout, ne demande pas d'expliquer!

**patricktoulon** · 14/03/2019, 16h58

salut marcel
c'est une adaptation mon plus vieux code ca
tu n'a besoins que de 2 api windows en fait
tout ce qui est gdi getsystemmetric et tout et tout tu peux virer
tu veux un exemple ?

**MarcelG** · 14/03/2019, 17h02

Il me semblait bien qu'un certain Toulon Patrick m'avait aiguillé vers ce type de code.
Sauf erreur, cela doit remonter à quelques temps déjà.

Si tu as un code épuré (avec si possible croix de fermeture masqué), alors oui je suis preneur.
Merci par avance.

**LaureneW** · 14/03/2019, 17h07

Merci pour vos réponses à tous les deux, voici le code qui manquait en effet Patrick,
Là je dois partir, mais j'essaie vos code demain !

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
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0 'Screen width
Private Const SM_CYSCREEN = 1 'Screen height
 
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 Const LOGPIXELSX = 88 'Pixels/inch in X
'
'A point is defined as 1/72 inches
Private Const POINTS_PER_INCH As Long = 72
 
'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
 
'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

**patricktoulon** · 14/03/2019, 17h16

et si on fesait plus simple
adapté pour 32/64 bits
marcel si tu veux en plus les 3 boutons alors 3 apis et c'est tout aucun calcul en pixel et tout le toutim
voila la version simplifié au max

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
#If win64 Then'64 bits
    #If vba7 Then
        Private  Declare ptrsafe Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare ptrsafe  Function showw Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
        Private Declare  ptrsafe Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    #Else'vba6
        Private Declare Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare Function showw Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
        Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    #End If
#Else'32bits
    Private Declare Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function showw Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If
Dim WW As Double
Dim HH As Double
Private Sub UserForm_Activate()
    For Each ctrl In Me.Controls
        ctrl.Tag = ctrl.Tag & ctrl.Top & ";" & ctrl.Left & ";" & ctrl.Width & ";" & ctrl.Height
    Next
    SetWindowLongA fwa(vbNullString, Me.Caption), -16, &H94CF0080
    showw fwa(vbNullString, Me.Caption), 3
End Sub
Private Sub UserForm_Initialize()
    WW = Me.Width: HH = Me.Height
End Sub
Private Sub UserForm_Resize()
    Dim newW#, newH#
    newH = Me.Height / HH: newW = Me.Width / WW
    For Each ctrl In Me.Controls
        tbl = Split(ctrl.Tag, ";")
        ctrl.Top = tbl(0) * newH: ctrl.Left = tbl(1) * newW
        'redimentionnement(facultatif)pour tous sauf les conteneurs
        'If TypeName(ctrl) = "MultiPage" Or TypeName(ctrl) = "Frame" Then
        ctrl.Height = tbl(3) * newH: ctrl.Width = tbl(2) * newW
        'End If
        'si on ne veut redimentionner que les conteneur (frame,multipage) on debloque les ligne vertes
    Next
End Sub

voila

**MarcelG** · 14/03/2019, 17h28

Patrick,

Tout ce code est placé dans celui de mon formulaire.
Celui-ci ne se redimensionne pas.
En effet, la procédure évènementielle Resize ne s'exécute pas.

**patricktoulon** · 14/03/2019, 17h32

a bon ???
edit
un moment j'en profite que j'ai la pitchoune avec son pc portable pour tester sur W10 64 et excel 2016 64 bits

**MarcelG** · 14/03/2019, 17h44

Toujours pas.

Ton applicatif fonctionne bien sur mon poste mais ton développement est inefficace sur le mien.

Je vois une grande plage blanche mais mon formulaire est affiché sur mon 2ème écran.

J'ai placé une Msgbox dans la procédure Resize.
Cette Msgbox ne s'affiche pas.
Pour confirmation, quelle méthode entraîne le redimensionnement?

**patricktoulon** · 14/03/2019, 18h34

re
c'est bizarre ce que tu me dis
le plein ecran est fait avec l'api showWindow alias showw avec l'argument "3"
la methode c'est l'evenement resize du userforme lui meme
tu est sur d'avoir tout mis dans le userform ???
et tu me dis que ton msgbox ne s'affiche pas !!!
l'userform est il en plein ecran au moins ???

**MarcelG** · 14/03/2019, 18h44

Mon poste est à 2 écrans.
Le formulaire s'affiche mais en taille réduite, sur l'écran secondaire.
Ce n'est pas fondamental pour moi, Patrick. Je peux conserver les anciennes API.

**patricktoulon** · 14/03/2019, 19h11

bon je vais rééssayer ton conde chez moi
mais deja je vois une valeur arbitraire qui ne peut fonctionner que chez toi "0.98"

Code :

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

1
2
3
'Calcule le rapport de l'UserForm et la taille de l'écran
RW = 0.98 * ScreenWidth * PointsPerPixel / Me.width
RH = 0.98 * ScreenHeight * PointsPerPixel / Me.height

mais je vais tester quand meme

puré ta pas tout mis il manque des declarations d'api

**patricktoulon** · 14/03/2019, 19h57

tiens marcel je te l'ai refait au propre avec toutes les declarations

module

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
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public 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
Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
'
Private Const LOGPIXELSX = 88 'Pixels/inch in X
Private Const SM_CXSCREEN = 0 'Screen width
Private Const SM_CYSCREEN = 1 'Screen height
Public Const SW_MAXIMIZE = 3 'screen maximized pour l'api showWindow
Private Const POINTS_PER_INCH As Long = 72 'A point is defined as 1/72 inches
 
 
'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
 
'The size of a pixel, in points
Public Function PointsPerPixel() As Double
Dim Hdc As Long, lDotsPerInch As Long
Hdc = GetDC(0)
lDotsPerInch = GetDeviceCaps(Hdc, LOGPIXELSX)
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, Hdc
End Function

userform

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
'*******************************************************************************
Private Sub UserForm_Initialize()
 
'If Is_Marcel Then GoTo lasuite
 
'Empêcher croix de fermeture
Dim hwnd As Long
'hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") & "Frame", Me.Caption)
'SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
 
hwnd = FindWindowA(vbNullString, Me.Caption)
SetWindowLongA hwnd, -16, &H84C00080
 
'-------------------------------------------------------------
'Déclaration des variables RX et RH
Dim RW As Single, RH As Single
 
'Calcule le rapport de l'UserForm et la taille de l'écran
RW = 0.98 * ScreenWidth * PointsPerPixel / Me.Width
RH = 0.98 * ScreenHeight * PointsPerPixel / Me.Height
'Debug.Print RW
'Debug.Print RH
 
'Met l'UserForm en plein écran
Me.Width = 0.98 * ScreenWidth * PointsPerPixel
Me.Height = 0.98 * ScreenHeight * PointsPerPixel
 
'Déclaration de la variable Ctl qui correspond aux contrôles de ton UserForm
Dim Ctl As MSForms.Control
 
'Call déclare_couleurs
 
'Permet de redimensionner tous tes contrôles présent sur l'UserForm en fonction de la taille de l'userForm et de la taille de l'écran
For Each Ctl In Me.Controls
 
        With Ctl
 
                .Move .Left * RW, .Top * RH, .Width * RW, .Height * RH
                'If TypeOf Ctl Is MSForms.TextBox Or TypeOf Ctl Is MSForms.Label Then
                        'Ajuste la taille de police
                        With .Font
                                .Size = .Size * RW / RH * 1.5
                        End With
                'End If
                'Debug.Print .Name
        End With
 
 
Next Ctl
 
   'Pour garder l'userform au 1er plan
   'SetWindowPos FindWindowA(vbnullstring, Me.Caption),-1, 0, 0, 0, 0, 3
End Sub

j'ai modifier 2 ligne dans le usf tu me dira si ca marche si oui on peut supprimer getwindowlongA
alors ca ne maximise pas le userform ca l'agrandi c'est pas la meme chose
et il fait pas tout mon ecran en largeur et le bottom est beaucoup plus bas que la taskbar c'est pour ca que tu l'a sur l'ecran que tu veux
car quand on maximize vraiment ca se met en plein ecran dans l'ecran 1
il faudra m'expliquer 0.98

**LaureneW** · 15/03/2019, 10h11

Re,
Pour ma part, ton code fonctionne très bien Patrick, merci beaucoup tu m'enlèves une sacrée épine du pied !

**MarcelG** · 15/03/2019, 13h27

Salut Patrick,

Ton code est effectif!

Le coefficient .098 m'a servi à un moment donné où j'avais des problèmes de résolution d'écran. Je l'ai ôté.

De mémoire, je crois qu'il est possible d'ôter la barre supérieure du formulaire. Je ne m'en souviens plus du code.

J'ai ôté la croix de fermeture. (Pour ceux qui nous lisent, attention de prévoir un bouton "Quitter")

Code :

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

1
2
3
Dim hwnd As Long
hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") & "Frame", Me.Caption)
SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF

GetWindowLongA est utilisé pour la gestion de cette croix.
Que doit-on en faire? ("J'y entrave queut'chi"

)

En attendant ton retour, bravo et merci

**patricktoulon** · 15/03/2019, 14h27

re ben en fait j'ai abrégé ton code

j'ai remplacer ceci

Code :

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

1
2
hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") & "Frame", Me.Caption)
SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF

Code :

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

1
2
3
par cela 
hwnd = FindWindowA(vbNullString, Me.Caption)
SetWindowLongA hwnd, -16, &H84C00080

pourquoi:
et bien par ce que tu te sert de getwindowlong pour capter l'état de la fenêtre et lui ajouter &HFFF7FFFF
ce qui donne un long pour la fenêtre de &H84C00080
donc moi je saute l'étape de la détermination puisque je connais le long(hex) de la fenêtre sans les boutons
je n'est donc plus besoins de l'api getwindowlongA
je passe directement à l'état que je veux
pour info
voici les api qui sont vraiment utiles pour toute transformation classique de la caption version 32 bits

Code :

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

1
2
3
4
5
6
7
8
'application des modification
Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'trouver le handle
Private Declare Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'on redessine la barre sinon elle se retrouve en bas de l'userform (artefact)quand on la suprime 
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
'afficher le userform 1 mode fenetre ,2 mode reduit , 3 plein ecran
Private Declare Function showw Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

divers exemple d'application que j'ai compacté dans ma classe formica que l'on devrait retrouver sur DVP en cherchant un peu elle date un peu d'accords

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
Dim handle
Sub elastique(usf)
    handle = fwa(vbNullString, usf.Caption)
    SetWindowLongA handle, -16, &H94CC0080                      ' juste l'elasticité
End Sub
'
Sub bouton_max(usf)
    handle = fwa(vbNullString, usf.Caption)
    SetWindowLongA handle, -16, &H94C90080                      'bouton maximiser
End Sub
'
Sub bouton_max_elastique(usf)
    handle = fwa(vbNullString, usf.Caption)
    SetWindowLongA handle, -16, &H94CD0080                      'bouton maximiser et elasticité(redimentionable par la souris en choppant les coin ou les bord de l'userfom )
End Sub
'
Sub bouton_minimiser(usf)
    handle = fwa(vbNullString, usf.Caption)
    SetWindowLongA handle, -16, &H94CA0080                      'bouton minimiser
End Sub
'
Sub bouton_min_elastique(usf)
    handle = fwa(vbNullString, usf.Caption)
    SetWindowLongA handle, -16, &H94CE0080                      'bouton minimiser et elasticité(redimentionable par la souris en choppant les coin ou les bord de l'userfom )
End Sub
'
Sub bouton_max_min(usf)
    handle = fwa(vbNullString, usf.Caption)
    SetWindowLongA handle, -16, &H94CB0080                      'bouton minimiser et maximiser
End Sub
'
Sub max_min_elastique(usf)
    handle = fwa(vbNullString, usf.Caption)
    SetWindowLongA handle, -16, &H94CF0080                      'bouton minimiser et maximiser et élasticité(redimentionable par la souris en choppant les coin ou les bord de l'userfom et le bouton )
End Sub
'
Sub no_bouton(usf)
    handle = fwa(vbNullString, usf.Caption)
    SetWindowLongA handle, -16, &H94C00080                      'sans bouton
End Sub
'
Sub no_bouton_elastique(usf)
    handle = fwa(vbNullString, usf.Caption)
    SetWindowLongA handle, -16, &H94C40080                      'sans bouton elastique(redimentionable par la souris en choppant les coin ou les bord de l'userfom )
End Sub
'
Sub no_caption(usf)
    handle = fwa(vbNullString, usf.Caption)
    SetWindowLongA handle, -16, &H94080080: SetWindowLongA handle, -20, &H0:    ' sans caption
    DrawMenuBar handle
    usf.BorderStyle = 0: usf.SpecialEffect = 0
End Sub
'
Sub no_caption_cadre_coin_rond_elastique(usf As Object)
    handle = fwa(vbNullString, usf.Caption)
    SetWindowLongA handle, -16, &H140F0101                      ' sans caption cadre epais coin  arrondi et elastique(redimentionable par la souris en choppant les coin ou les bord de l'userfom )
    DrawMenuBar handle
    'usf.show 0
End Sub
'
Sub no_caption_cadre_epai_carré(usf As Object)
    handle = fwa(vbNullString, usf.Caption)
    SetWindowLongA handle, -16, &H140B0101                      ' sans caption cadre epais carré
    DrawMenuBar handle
     'usf.show 0
End Sub
'
Sub normal(usf)
    handle = fwa(vbNullString, usf.Caption)
    SetWindowLongA handle, -16, &H94C80080                      'userform  normal
    DrawMenuBar handle
End Sub
'
sub plein_ecran(usf)
handle = fwa(vbNullString, usf.Caption)                                ' plein ecran sans modifier la caption ni bouton  ( reelle maximisation)
  showw handle,3
End sub

il ne reste plus qu'a appeler une de ces subs en fonction de se que l'on désire (voir commentaires pour chaque sub) dans le activate du userform
en faisant comme ça je peux passer d'un état à l'autre sans devoir calculer le getwindows long pour savoir quoi ajouter ou enlever

**MarcelG** · 15/03/2019, 14h33

Salut Patrick,

OK Merci.
Juste une dernière question (pour ceux qui nous lisent)
Ces développements peuvent-ils s'appliquer à toutes les versions d'Office?

Positionnement de contrôles par rapport à une userform

Macros et VBA Excel

Discussions similaires

Partager

Partager