Dimensionner un Userform

Invité · 25/09/2013, 20h38

Envoyé par nibledispo

Bonjour Nouveau2,

J'ai trouvé la réponse aux deux questions que je te posais dans les documents proposés par Patrick (hélas pour moi en Anglais) et Vcottineau (heureusement pour moi en Français). Merci.

Je crois finalement, au vu des difficultés et de l'intérêt à peu près nul (pour moi) de la version 64 bit que je vais redemandé l'installation en 32 bits si Microsoft ne fait pas de difficulté.

Cordialement.

C'est sans doute une bonne idée étant donné que certains contrôles supplémentaires de formulaires ne sont pas supportés en 64 bits.

**eliot.raymond** · 26/09/2013, 16h28

Bonjour a tous, Forum Bonjour.

Salut Patrick,

Je sais, enfin je crois savoir pourquoi mes traits disparaissent quand j'essai

d'agrandi mon USF.

les controles sont collés beaucoup trop près les uns des autres.

j'ai donc revu ma présentation et décallés très légèrement tous mes controles

tout en gardant un bel aspect et là miracle, c'est nickel.

Donc félicitations pour ton code.

Quand je bouge l'USF par les angles ca suis bien plus de problème y compris

sur PC portable.

Par contre, svp, je veux bien comme tu me le propose au post #18 me faire

une version allégé de ton code juste pour mon utilité perso et adapter a mon

programme.

C'est juste le cas des 3 boutons et l'élasticité (bouton 4)

et de ne plus voir apparaitre la fenètre avec l'adresse (94CF0080)

J'ai eu du mal mais ca avance bien

Encore merci a toi pour ton aide et pour ton code.

A plus tard Patrick

Cordialement Ray

**patricktoulon** · 26/09/2013, 17h31

Bonjour
je m'en occupe pour ta version hyper allégée
après oui Evidemment selon la puissance de ta carte graphique tu peux avoir des ratés(souvent sur les portables )

apres pour repondre a docmarti au sujet des font size (travail fastidieux)
c'est faux ca ne l'est absolument pas

il suffit de mettre dans la boucle du depart et boucle du resize

Code :

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

1
2
3
if typename(ctrl)="CommandButton" or typename(ctrl)="TexBox" etc....  then 
 
ctrl.font.size=..........

tout simplement
ainsi l'exception se fait que sur le font size mais pas sur le resize ,l'erreur ne peut pas arriver,c'est d’ailleurs ce que je fait dans tout mes modules

au plaisir

Bonjour eliot

voila un code simplifié

etant donné que tu avais un probleme avec getwindows je ne l'utilise plus dans celui ci j'utilise "findwindow" qui elle est nominative puisque onse sert de la variable uf(userform )pour l'identifier

j'ai aussi rajouté des commentaires dans les deux fonctions en ce qui concerne le font.size pour que tu puisse comprendre comment j'evite l'erreur fatale sur un control qui n'a pas de font.size

je trouve mieux que de devoir gerrer les erreur avec on error......
enfin assez de blala voila le code que tu dois mettre dans un 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
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
 
'*                                     CREATEUR :Patrick toulon 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                                              *
'*                                                                                                                    *
'* REVISION:21:02:2013(Modification de la gestion du font.size)                                                       *
'*le font size est géré control par control ,il peuvent donc avoir un fontsize différent                           *
'* REVISION:26:02:2013 (modification de la memorisation des dimention
'*tout est dans le tag
'* on ne cherche plus le handle de l'userform on se sert de l'api "getactivewindow" directement dans le ligne de modification des propertie de l'userform
' on ne se sert plus de l'api "getwindowslonga" non plus ,des nombre au format hex  representant les properties sont directement injectées dans la ligne de modification
' version aleger pour
 
 
 
'**********************************************************************************************************************
Option Explicit
#If VBA7 Then
     'api pour changer le mode d affichage du userform et activer ou non la fenetre
    Public Declare PtrSafe Function SWH Lib "user32" Alias "ShowWindow" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    ' api pour changer le mode d affichage du userform et activer ou non la fenetre
    Public Declare PtrSafe Function SWA Lib "user32" Alias "ShowWindowAsync" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
     ' api pour redresser l'affichage en cas de modification de la caption
    Public Declare PtrSafe Function DMB Lib "user32" Alias "DrawMenuBar" (ByVal hwnd As LongPtr) As Long
      #If Win64 Then
         Public Declare PtrSafe Function SWLA Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Public Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
          #Else
         'api pour trouver et identifier le handle de la fenetre (identifiant de la fenetre
         Public Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
         'api pour appliquer le nouveau style a la fenetre (userform)
         Public Declare PtrSafe Function SWLA Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
      #End If
 
#Else
   'api pour trouver et identifier le handle de la fenetre (identifiant de la fenetre
    Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
      'api pour appliquer le nouveau style a la fenetre (userform)
    Public Declare Function SWLA Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
     'api pour redresser l'affichage en cas de modification de la caption
    Public Declare Function DMB Lib "User32" Alias "DrawMenuBar" (ByVal hWnd As Long) As Long
#End If
 
 
Dim Ctl As Object, ctrl As Object
Dim Properties
 
#If VBA7 Then
    Dim oldlong As LongPtr
    Dim handle As LongPtr
#Else
    Dim handle As Long
    Dim oldlong As Long
#End If
 
'constante possible et utilisables pour la modification de la caption de l'userform
'   &H94CB0080 = les trois boutons
'   &H94C00080 = le bouton minimiser
'   &H94C90080 = le bouton maximiser
'   &H94CC0080 = l'elasticité
'   &H94CF0080 = les trois boutons et l'élasticité >>>>>supporte l'aero Snap(seven et window8
'   &H94080080 = pas de caption
'   &H94C00000 = sans bouton sur la caption
'   &H140F0101 = sans caption avec cadre large coin arrondi et elastic >>>>>supporte l'aero Snap(seven et window8
'   &H94C40000 = sans bouton sur la caption avec élasticité
Function modif_userform(uf As Object, Optional modif As Long = &H94CF0080)
  'on determine le handle de la form (identifiant de la fenetre)maintenant avec findwindows +precis lors du choix de la fentre a modifier
   handle = FindWindow(vbNullString, uf.Caption)
 
        'on va memoriser le multiplicateur des dimention de l'usf par rapport a chaque controls dans leurs tags respectifs
    For Each ctrl In uf.Controls                                                                                  '*
        ctrl.Tag = uf.InsideWidth / (ctrl.Left + 0.01) & ":" & uf.InsideHeight / (ctrl.Top + 0.01) & ":" & uf.InsideWidth / ctrl.Width & ":" & uf.InsideHeight / ctrl.Height
        'ici en fonction du type de control si il a  la propriété font size on place l'operateur en derniere position dans le tag
        If TypeName(ctrl) <> "ScrollBar" And TypeName(ctrl) <> "Image" And TypeName(ctrl) <> "SpinButton" Then ctrl.Tag = ctrl.Tag & ":" & uf.InsideWidth / ctrl.Font.Size                                                                       '*
    Next
    'on applique les modification a la fenetre userform en une seule ligne
    SWLA handle, -16, modif: SWLA handle, -20, &H0: DMB handle
 
End Function
 
Sub maForm_Resize(usf As Object)
          'ici on boucle sur tout les controls
        For Each Ctl In usf.Controls
            Properties = Split(Ctl.Tag, ":") 'on coupe le tag de chaque control par les double point
            'chaque morceau du texte du tag corespond a un operateur
 
            'et on applique le multiplicateur au controls pour la largeur et la hauteur en une seule ligne
            'left,top,largeur,hauteur,
            Ctl.Move usf.InsideWidth / Properties(0), usf.InsideHeight / Properties(1), usf.InsideWidth / Properties(2), usf.InsideHeight / Properties(3)
            'tout les controls qui ont le multiplicateur du font size enregistré dans leurs tags respectifs verront leur font size redimentionné en proportion
            If UBound(Properties) > 3 Then Ctl.Font.Size = Round(usf.InsideWidth / Properties(4), 0)
       ' autrement dit au depart si le control posedait cette propriété l'operateur c'est inscrit en derniere position dans le tag
       ' on l'applique alors
        Next
        usf.Repaint
  End Sub

et dans le userform tu juste ca :

Code :

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

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

voila voila
j'oubliais un peu de lecture avec la piece jointe

Au plaisir

**eliot.raymond** · 28/09/2013, 16h18

Bonjour a tous, bonjour forum

Salut Patrick

Tout d'abord un grand merci pour réponse, cependant j'aurai

trois petites questions si tu veux bien:

(1) Dans ton code en début de ligne tu mets une dièse (#) bah pourquoi ???

(2) Ci-dessous tu mets (Win64) et moi je suis en windows 7 32 bits

Code :

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

#If Win64 Then

(3) les déclarations (Public) apparaissent chez moi écrites en rouge une raison a ca ???

Sinon j'ai fait des essais avec ton code allègé et sous réserve mais pour moi ca fonctionne très bien pour l'instant, pas encore tester sur mon PC portable.

Patrick je te félicite pour la réalisation de ton code ainsi que pour ton savoir

Bonne fin d'après midi

PS: je m'occupe de la lecture que tu a joint, c'est en anglais, va me falloir un peu de temps

Cordialement Ray et

**patricktoulon** · 28/09/2013, 17h29

bonjour eliot

les # et if ne sont la que pour gérer le 32/64 bits
si tu tourne sur seven 32 ça ne te sert strictement a rien mais si un jour tu passe sur 64 bits tu n'aura pas a réécrire le code il fonctionnera aussi

pour la lecture si l'anglais te pose problème il y a pour fire foxe et internet explorer une toolbar nommée google toolbar dans la quelle il y a un outil traduction automatique ou pas je m'en sert depuis des années et ça fonctionne très bien

Voila Voila
ps j'ai réalisé ta version sur un portable (HP DV6 2007 sf) ecran 15/6 c'est impec

je l'ai testé sur mon ordi maison (the terminator ) sur ecran tele 107 et pas de différence ca fonctionne parfaitement bien

Au plaisir

**eliot.raymond** · 28/09/2013, 17h58

Salut Patrick

Ok , merci pour tout Patrick

J'ai essayer sur mon PC portable un mot (nickel)

le code reste comme ca, ce n'ai pas gènant car effectivement sur mon

portable j'ai seven préinstallé en 64 bits.

pour la traduction et étant faché quelque peu avec l'anglais

j'ai ce qu'il faut, je vais de ce pas lire ces infos qui m'ont l'air très intérressantes.

Voila encore un grand grand merci a toi

Patrick un excellent W-end

je clos ce post c'est ok pour moi

Bien cordialement Raymond

**nibledispo** · 28/09/2013, 20h17

bonsoir Patrick,

Tu réponds à Eliot :

"Si tu tournes sur seven 32 ça ne te sert strictement a rien mais si un jour tu passes sur 64 bits tu n'auras pas a réécrire le code, il fonctionnera aussi"

Cette remarque m'interpelle par rapport à ma discussion "réinstaller office 2013"

Veux tu dire par-là que même si je réinstalle office en 32 bit, le problème des "ptrsafe" (et peut-être d'autres paramètres) se posera quand même dès lors que Windows 7 est installé en 64 bits (ce qui est mon cas) ?

Cela signifierait que les "ptrsafe" dépendent du 64 bits de Windows et non d'Excel.

S'il en est ainsi, il ne sert donc à rien pour moi de réinstaller office en 32 bits sauf à réinstaller également Windows 7 en 32 bits.

Cordialement.

**patricktoulon** · 01/10/2013, 15h14

Bonjour nible dispo

"Si tu tournes sur seven 32 ça ne te sert strictement a rien mais si un jour tu passes sur 64 bits tu n'auras pas a réécrire le code, il fonctionnera aussi"

Cette remarque m'interpelle par rapport à ma discussion "réinstaller office 2013"

si tu tourne sur 32 bits tu ne peux pas tourner avec office 64 bits

le dernier code sur les condition "#if" determine quelles declaration d'api doivent etre pises en compte c'est tout
dans tout las cas et surtout le cas present les librairies utilsée(user32) sont des librairies qui font partie de la structure meme de widows donc tu a la reponse a ta question

j'invite d'autre membres plus informés que moi sur la transition 32/64 bits a repondre si le coeur leur en dit ,car c'est quand meme assez difficile pour moi car des la sortie de Office 2010 j'ai diffinitivement abandonner l'intention de passer a office 64 bits trop de librairie différentes manque de composant activex ect....... j'ai donc continué a travailler avec 2007 32 bits et je travaille en 64 bits que pour les question du forum et pas pour moi

voivla voila

Au plaisir

Invité · 11/01/2014, 16h09

Salut Patrick,

Il semble qu'il y ai un petit oubli de ShowWindow et ShowWindowAsyn pour ceux qui ont une version antérieur a 2010.

Les déclarations devrait comme ça normalement (sauf erreur):

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
Option Explicit
#If VBA7 Then
     'api pour changer le mode d affichage du userform et activer ou non la fenetre
    Public Declare PtrSafe Function SWH Lib "user32" Alias "ShowWindow" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    ' api pour changer le mode d affichage du userform et activer ou non la fenetre
    Public Declare PtrSafe Function SWA Lib "user32" Alias "ShowWindowAsync" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
     ' api pour redresser l'affichage en cas de modification de la caption
    Public Declare PtrSafe Function DMB Lib "user32" Alias "DrawMenuBar" (ByVal hwnd As LongPtr) As Long
      #If Win64 Then
         Public Declare PtrSafe Function SWLA Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
          #Else
         'api pour trouver et identifier le handle de la fenetre (identifiant de la fenetre
         Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
         'api pour appliquer le nouveau style a la fenetre (userform)
         Public Declare PtrSafe Function SWLA Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
      #End If
 
#Else
   'api pour trouver et identifier le handle de la fenetre (identifiant de la fenetre
    Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
      'api pour appliquer le nouveau style a la fenetre (userform)
    Public Declare Function SWLA Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
     'api pour redresser l'affichage en cas de modification de la caption
    Public Declare Function DMB Lib "User32" Alias "DrawMenuBar" (ByVal hWnd As Long) As Long
     'api pour changer le mode d affichage du userform et activer ou non la fenetre
    Public Declare Function SWH Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    ' api pour changer le mode d affichage du userform et activer ou non la fenetre
    Public Declare Function SWA Lib "user32" Alias "ShowWindowAsync" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
 
#End If

Ça marchait parce que ces 2 fonctions n'étaient pas utilisés.

A+

**patricktoulon** · 14/01/2014, 17h22

Bonjour nouveau2

je ne peut pas infirmer ou confirmer ta dernière intervention car je travaille en 32 bits

bien que je doute que showwindow ne fonctionne pas en 64 bits sachant que c'est quand même la base de la user32 dll

il serait intéressant que des essais soient effectués et qu'un retour 100% affirmatif ou infirmatif soit retourné pour servir a d'autre

au plaisir

**nibledispo** · 15/01/2014, 09h37

bonjour Patrick,

c'est suite à cette discussion "Problème compatibilité 32bits et 64bits" du 11/01/13 que Nouveau2 a jugé utile cet apport.
l’intéressé travaille précisément sur 64bits et semble être arrivé à cette conclusion (enfin c'est ce que j'ai cru comprendre).

Cordialement,

Invité · 15/01/2014, 13h40

Salut,

Le problème intervient lorsque une personne à une version antérieur a Office 2010.

Code :

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

1
2
3
4
5
#If VBA7 Then
    ' Version Office 2010 et 2013 pour l'instant
#Else
    ' Version antérieur à Office 2010 (Office 2007 etc...)
#End If

Je ne peux pas tester car pas d'Office 2007, mais il faut autant de déclarations dans les 2 branches du If. C'est pour ça que j'ai rajouté les 2 fonctions qui manquaient, mais de toute façon, elles (les 2 fonctions manquante) ne sont pas utilisées dans ta dernière version. Donc, au final, ce n'est pas grave.

P.S.: Je viens de tester rapidement le code sous Excel 2013 64 bit, et ça fonctionne bien.

**patricktoulon** · 15/01/2014, 18h08

Bonjour a tous nickel si l'adaptation fonctionne

je mettrais ma base de donnée a jour
merci a nouveau2 pour sa contribution

au plaisir

Dimensionner un Userform [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager