Discussion :

[patricktoulon]

puré
bon allez tiens prends le c'est pour toi
démo en image et pièce jointe

c'est bon c'est resolu ?

[Alias_2003]

Bonjour Patrick,
Merci de ta patience ! C'est exactement ce que j'ai fait ! Par contre regarde ce que j'obtiens avec ton fichier (model special alias 2003.xls) (j'ai la même chose avec le mien) :




Edit : en modifiant la valeur de la variable pxtopoint de 0.6 à 0.75, le rendu est correct !
Par contre, lorsque j'affiche l'userform et que je modifie la résolution de mon pc (pour tester le redimensionnement auto), aucun redimensionnement n'est fait.
On ne repasse pas par UserForm_Resize.
Fais le test tu verras !

[patricktoulon]

quand tu change la résolution de ton écran tu ne passe pas par le resize car en fait ton userform ne se resize pas
c'est juste ton écran qui change de résolution et la rein a faire on ne peut pas capter le changement de résolution
du moins si mais c'est trop compliqué et pas fiable du tout
tu tourne avec quoi office 32 ou 64 ?

ps je viens de tester sur 3 ordis mon fichier il fonction sur les 3
res1 1920X1080
res2 1280x720
res3 ecran 4/3(vielle becanne) 800X600

mais bon j'avoue que tu me perds dans tes explications

que cherche tu vraiment a faire ??
essaie d'être précis par ce que la on pollue ma contribution et avec toi on a passé plus d'une page et ce qui cherchent ce genre de manip vont se perdre

[patricktoulon]

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


voila le résultat en gardant la 3 Emme option dans le userform


Wagadougouh!!!!!

[Alias_2003]

Bonsoir Patrick,

essaie d'être précis par ce que la on pollue ma contribution et avec toi on a passé plus d'une page et ce qui cherchent ce genre de manip vont se perdre

Tu as raison et j'aurais du créer un post plutôt que polluer le tien. Toutes mes excuses.
J'ai testé ton code du dernier post et c'est juste parfait ! MERCI beaucoup de ta patience et de ta persévérance.
Bonne soirée,
Amicalement

[patricktoulon]

de rien au plaisir
en général si je sort l'artillerie lourde y les apis valsent dans les modules

[Many31]

Merci pour ton travail

Il claque bien

Perso j'ai utilisé plutot la hauteur comme référence pour redimmensionner le texte (c'est surtout que les écrans 16:9 pullulent) mais pour le reste je ne peux que saluer le résultat.

Au passage si je peux me permettre, tu devrais compléter ton premier poste avec "l'artillerie lourde" car il roxe plus que le premier.

++

edit : c'est marrant suis également de Toulon. céléméyeur!

[Allanbzh]

Bonjour la communauté

Tout d'abord merci Patrick pour ton travail ! c'est génial !

Il me reste tout de meme un probleme, tout fonctionne bien mais lorsque je passe sur du 64 bits aie aie aie (tout en version 2013)

J'ai pourtant repris le code en page 2 que je recolle ici :

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
'**********************************************************************************************************************
'*                                     CREATEUR :Patricktoulon Alias chamalin1@msn.com                               *
'*                                                    DATE :23/09/2010                                                *
'*                                       UTILISATION D'UNE SEULE API LE "USER32.DLL"                                  *
'*                                    EXEMPLE DE USERFORM REDIMENTIONNABLE NOUVELLE VERSION                           *
'*                                      LES CONTROLS SONT REDIMENTIONNES EN MEME TEMPS                                *
'*                                               AINSI QUE LES FONT SIZE                                              *
'**********************************************************************************************************************
 
#If Win64 Then
   public Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongLong
   Public Declare PtrSafe Function ShowWindow Lib "User32" (ByVal hWnd As LongLong, ByVal nCmdShow As LongLong) As LongLong
   Public Declare PtrSafe Function SWLg Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As LongLong, ByVal nIndex As LongLong, ByVal dwNewLong As LongLong) As LongLong
 
#Else
   'Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   Public Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
   Public Declare Function SWLg Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
 
#End If
 
#If VBA6 Then
    'si on travaille avec office 32 bits
    Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    'Public Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
    'Public Declare Function SWLg Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
 
#ElseIf VBA7 Then
    'si on travaille avec office 64 bits
    public Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Public Declare PtrSafe Function SWLg Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Longptr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Longptr
    Public Declare PtrSafe Function ShowWindow Lib "User32" (ByVal hWnd As Longptr, ByVal nCmdShow As Longptr) As Longptr
 
#End If
 
Public old_largeur As Long, handle As Long, old_hauteur As Long, newhauteur As Single, newlargeur As Single
Public Ctl As Object
 
 
 
Sub trois_boutons(uf As Object)    'on va ajouter les deux boutons manquants et l'élasticité a l'userform
'*****************************************************************
'*ici on memorise les dimention de depart de l'userform          *
    old_largeur = uf.InsideWidth: old_hauteur = uf.InsideHeight    '*
'*****************************************************************
'***************************************************************************************************************
' ici on determine le handle                                                                                   *
    handle = FindWindow(vbNullString, uf.Caption)    '                                                         *
' ici on applique les changement (&H84CF0080= les trois bouton et l'elasticité)                                *
    SWLg handle, -16, &H84CF0080                                                                              '*
'***************************************************************************************************************
'***********************************************************************************************************************************************************
'on memorise a l'interieur du tag du control ses propriétés ainsi que son son font size                                                                   '*
    For Each ctrl In uf.Controls                                                                                                                          '*
        ctrl.Tag = ctrl.Left & ";" & ctrl.Top & ";" & ctrl.Width & ";" & ctrl.Height                                                                      '*
        If TypeName(ctrl) <> "SpinButton" And TypeName(ctrl) <> "Image" And TypeName(ctrl) <> "ScrollBar" Then ctrl.Tag = ctrl.Tag & ";" & ctrl.Font.Size '*
    Next                                                                                                                                                  '*
'***********************************************************************************************************************************************************
End Sub
Sub plein_ecran()
' on affiche le userform en plein ecran avec l'api showwindowa de la user32.dll  bien moins lourd que mes versions precedente de maximisation de l'userform et plus rapide et plus propre
'1= mode normal:3 =maximiser:6 =minimiser
'le handle du userform a été declaré en public au debut du module et  identifié dans la routine des trois boutons il n'est donc plus necessaire de l'identifier
ShowWindow handle, 3
 
End Sub
Sub maForm_Resize(usf As UserForm)
'ici on determine le multiplicateur qui differenci la dimention de base a celle actuelle de l'userform
    newlargeur = usf.InsideWidth / old_largeur: newhauteur = usf.InsideHeight / old_hauteur
    'ici on boucle sur tout les controls
    For Each Ctl In usf.Controls
        ppe = Split(Ctl.Tag, ";")    'on coupe le tag par les ";"
        'et on applique le multiplicateur au controls pour la largeur et la hauteur en une seule ligne
        Ctl.Move ppe(0) * newlargeur, ppe(1) * newhauteur, ppe(2) * newlargeur, ppe(3) * newhauteur
        'l'element(4) de ppe contient le font size du controls
        If UBound(ppe) = 4 Then Ctl.Font.Size = ppe(4) * newlargeur
    Next
End Sub

Si quelqu'un a une idée je suis preneur !

Merci et bonne journée.

Allanbzh

[patricktoulon]

salut c'est quoi aie aie aie ???

[Allanbzh]

Bonsoir Patrick,

Voici l'erreur que j'obtiens :



De ce fait, lorsque je déverrouille (j’enlève le mot de passe de la macro) j'obtient :



Le code est bien copier/coller et dans le userform j'ai garder la même chose qu'avant comme vous l'avez conseillé

Merci pour votre aide !

Allanbzh

[patricktoulon]

Bonjour
si le code est dans un userform et pas dans un module standard ou classe c'est private et pas public

[Allanbzh]

Bonjour Patrick,

Il est bien dans une module standard...

Cordialement,

AllanBzh

[Allanbzh]

Re,

Cela ne fonctionne pas sur certains 64bits mais sur certains cela fonctionne et je ne connais pas l'explication.... En revanche, sur les ordinateurs ou la macro veut bien se lancer, l'userform est d'une très grande taille et ne s'adapte pas a mon écran mais je ne comprends pas pourquoi .... Je peux envoyer mon fichier avec les données confidentielles retirées si cela peut aider à la compréhension

Merci à vous

AllanBzh

[patricktoulon]

avant tu me dis

Le code est bien copier/coller et dans le userform j'ai garder la même chose qu'avant comme vous l'avez conseillé

et apres

Bonjour Patrick,

Il est bien dans une module standard...

Cordialement,

AllanBzh

va y envoie la sauce ca ira plus vite

[Allanbzh]

Re,

Oui car en 2eme page de ce sujet : "le code dans le userform n'a pas changer chez moi" C'est juste de même pour moi.

=>> J'ai du supprimer beaucoup de chose au final car cela ne passait pas sur le forum sinon

Merci Patrick

[patricktoulon]

j'ai ouvert ton fichier
il faut un mot de passe
il manques des référence
et il m'autorise a rien msgbox erreur les un derrières les autres
bref je peux rien pour toi

[Allanbzh]

Bonsoir Patrick,

C'est assez bizarre effectivement car je viens de l'ouvrir sur mon PC où je n'arrive pas à avoir le bon redimensionnement et il est bien déverrouillé de tout mot de passe (au cas où c'est "1995" sans guillemet).

Pour les refs j'ai tout supprimer le code dans le Userform, sinon c'est le DATAPicker (nécessaire d'avoir le fichier MSCOCT2.ocx pour pouvoir le voir) mais je ne l'ai pas sur cet ordi et avec un simple click sur "Ok" le message disparaît.

J'espère qu'avec cette version tu pourras y voir plus clair, même si tu n'as pas réussi à l'ouvrir merci d'y avoir déjà tenté de jeter un œil.

Bonne soirée à vous

Allanbzh

[patricktoulon]

ok
le mot de passe est toujours demandé bon je le met est j'accede au code


bon ya bien un mélimélo de plusieurs de mes méthodes proposées au fil des années mais bon c'est une purée ou une maman ours ne retrouverait pas ces petits
d'autant plus que les dernieres propsitions a divers endroits sont encore plus simple
toujours est que

1. le userform est déjà plus grand a la base
2. l'appel a la sub des api pour le modifier n'est même pas faite( ca risque pas de marcher même avec les bonnes déclaration d'api )

je vais voir dans la soirée si j'ai un moment pour te faire un full screen avec redim controls simple

assassin de code va !!!!!!!!

[patricktoulon]

BON CI C'EST CA QUE TU VEUX ?

alors pour commencer tu va mettre ca dans ton userform

Code :

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

1
2
3
4
5
6
7
8
 
Private Sub UserForm_Activate()
fullscreen Me
End Sub
 
Private Sub UserForm_Resize()
maForm_Resize Me
End Sub

suprime ton module qui lance

dans le modul resize tu met ceci :

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
'**********************************************************************************************************************
'*                                     CREATEUR :Patricktoulon Alias <a href="mailto:chamalin1@msn.com">chamalin1@msn.com</a>                               *
'*                                                    DATE :23/09/2010                                                *
'*                                       UTILISATION D'UNE SEULE API LE "USER32.DLL"                                  *
'*                                    EXEMPLE DE USERFORM REDIMENTIONNABLE NOUVELLE VERSION                           *
'*                                      LES CONTROLS SONT REDIMENTIONNES EN MEME TEMPS                                *
'*                                               AINSI QUE LES FONT SIZE                                              *
'**********************************************************************************************************************
 
#If VBA6 Then
    'si on travaille avec office 32 bits
    Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Public Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
    Public Declare Function SWLg Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#ElseIf VBA7 Then
    'si on travaille avec office 64 bits
    Public Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Public Declare PtrSafe Function SWLg Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPtr
    Public Declare PtrSafe Function ShowWindow Lib "User32" (ByVal hWnd As LongPtr, ByVal nCmdShow As LongPtr) As LongPtr
#End If
Sub Lance1()
   DATA_Recorder.Show 1
End Sub
Sub fullscreen(uf As Object)    'on va ajouter les deux boutons manquants et l'élasticité a l'userform
    uf.Tag = uf.Width & ":" & uf.Height
    handle = FindWindow(vbNullString, uf.Caption)    '
    SWLg handle, -16, &H84CF0080
      For Each ctrl In uf.Controls                                                                                                                          '*
        ctrl.Tag = ctrl.Left & ";" & ctrl.Top & ";" & ctrl.Width & ";" & ctrl.Height                                                                      '*
        If TypeName(ctrl) <> "SpinButton" And TypeName(ctrl) <> "Image" And TypeName(ctrl) <> "ScrollBar" Then ctrl.Tag = ctrl.Tag & ";" & ctrl.Font.Size    '*
    Next                                                                                                                                                  '*
      ShowWindow handle, 3
End Sub
Sub plein_ecran()
ShowWindow handle, 3
End Sub
Sub maForm_Resize(usf)
   W = usf.Width / Split(usf.Tag, ":")(0): H = usf.Height / Split(usf.Tag, ":")(1)
    For Each Ctl In usf.Controls
        ppe = Split(Ctl.Tag, ";")    'on coupe le tag par les ";"
         Ctl.Move ppe(0) * W, ppe(1) * H, ppe(2) * W, ppe(3) * H
          If UBound(ppe) = 4 Then Ctl.Font.Size = ppe(4) * H
    Next
End Sub

bien entendu j'ai tout réduis a la base
je te donne donc le fichier

[Allanbzh]

Bonjour Patrick,

Oui je suis un assassin LOL, mais je n'ai pas trouvé de version plus récente ailleurs ?! Bref en tous les cas merci je me suis servi du code que tu as coller et j'ai retravailler l'userform et c'est parfait ! Exactement ce que je voulais

Merci beaucoup pour le temps que vous m'avez consacré, j'en suis très reconnaissant !

Passez une bonne journée.

Allan