Aide redimensionnement Userform colonnes listbox

Version imprimable

06/05/2017, 06h54
Apoulit

Aide redimensionnement Userform colonnes listbox

Bonjour je suis tombé sur ce post de patricktoulon que je félicite pour ça contribution où l'on peut redimensionner un userform afin que le contenu puisse prendre une taille proportionnelle à celle de l'userform , et j'ai été agréablement surpris de voir que cela fonctionnait plus tôt bien.
En poussant un peu plus loin je me suis heurté à un problème concernant les listbox dont le contenu serait sous forme de colonne comme ci dessous :

Code:

ListBox1.ColumnWidths = "60;97;85;125;60;25;70;70;110;125"

Comment pourrions nous faire pour adapter un code sous forme de condition au premier abord ( c'est l'idée qui met venu ) qui pourrait conditionner les largeurs des colonnes ?
Partons du principe qu'un userform fasse 975 en largeur et que l'on agrandisse celui ci. Il y a t'il une solution pour connaitre sa taille une fois qu'il est agrandit ( variable T )?
Peut être que nous pourrions faire en sorte que les colonnes s’adaptent en fonction de la taille T ou de mettre en place des conditions du type:
T=975 ; T>975

Voilà merci d'avance.

1 pièce(s) jointe(s)

regarde je n'ai pas repris ma classe je l'ai fait dans un userform simple

Code:

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
'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
Dim raport
Dim rr
Private Sub UserForm_Activate()
    Handle = fwa(vbNullString, Me.Caption)
    SetWindowLongA Handle, -16, &H94CF0080
    With ListBox1
        raport = Me.Width / .Width
        rr = Round(Width / 50)
        For i = 1 To 20
            .AddItem "col 0 item " & i
            For col = 1 To 5
                .List(.ListCount - 1, col) = "col " & col & "item " & i
                .ColumnWidths = "50;50;80;80;80"
            Next
        Next
    End With
    Debug.Print ListBox1.ColumnWidths
End Sub
Private Sub UserForm_Resize()
    ListBox1.Width = Me.Width / raport
    w = Round(ListBox1.Width / rr)
    ListBox1.ColumnWidths = w & " pt;" & w & " pt;" & w & " pt;" & w & " pt;" & w & " pt"
   End Sub

Pièce jointe 276776

19/05/2017, 07h14
Apoulit

1 pièce(s) jointe(s)

Bonjour, merci pour la réponse.
Dans un premier temps:

J'ai essayé de reproduire ton code et les colonnes se mettent pas sur l'horizontale , quelques chose m'échappe... (voir fichier joint )
Sur l'exemple perso où je veux reproduire le code elles se mettent bien à l'horizontale ?

ensuite ...
J'ai un soucis avec les labels ( titres colonnes ) qui ne s'aligne pas ( normal ) ... voir exemple fichier joint.

Il y a pas un moyen de coder avec le principe suivant ?:

si userform taille initiale

.ColumnWidths = "50;50;80;80;80"

si agrandit ( plein ecran )

.ColumnWidths = "150;150;180;180;180"
(valeurs mis au hasard pour augmenter l espacement )

si retour taille initiale

.ColumnWidths = "50;50;80;80;80"

Merci.
19/05/2017, 10h18
patricktoulon

re

Bonjour
c'est pas étonnant tu a tout mélangé du redim les prorata 2 fois sur 2 module différents et j'en passe
c'est soit tu le fait dans le userform soit dans un module
et en plus tu t'es basé sur le model le plus ancien
je vais regarder cela

2 pièce(s) jointe(s)

re
allez cadeau;)
un exemple en demo

code userform

Code:

1
2
3
4
5
6
7
Private Sub UserForm_Activate()
ListBox1.List = Range("A1:E10").Value
depart Me
End Sub
Private Sub UserForm_Resize()
maform_resize Me
End Sub

code dans un module standard

Code:

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
Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function fwa Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
'SUB DE DEMARAGE MEMORISATION DIMENTIONS
Sub depart(usf)
    SetWindowLongA fwa(vbNullString, usf.Caption), -16, &H94CF0080  'Api window pour mettre les boutons minimiser et maximiser et l'élasticité
    usf.Tag = usf.Width & ":" & usf.Height    'on memorise les dimention du userform dans son tag
    nofont = "ScrollBar, SpinButton, Image"    'liste des controles qui n'ont pas de font
    For Each Ctrl In usf.Controls
        Ctrl.Tag = Ctrl.Left & ":" & Ctrl.Width & ":" & Ctrl.Top & ":" & Ctrl.Height    'on memorise les dimention des controles dans leur tag
        If Not nofont Like "*" & Left(TypeName(Ctrl), 5) & "*" Then Ctrl.Tag = Ctrl.Tag & ":" & Ctrl.Font.Size    'si il y a la propriété font alors on memorise aussi le fontsize
        If TypeName(Ctrl) = "ListBox" Then 'MEMORISATION DU COLUMNWIDTHS DE la listbox dans le tag sous la forme du string de l'array des dimentions
            tablwidth = Split(Replace(Ctrl.ColumnWidths, " pt", ""), ";")
            For i = 0 To UBound(tablwidth): tablwidth(i) = Val(tablwidth(i)): Next
            Ctrl.Tag = Ctrl.Tag & ":" & Join(tablwidth, "|")
        End If
    Next
End Sub
 
'SUB RESIZER GLOBAL
Sub maform_resize(usf)
    Dim WU, HU, D, Ctrl, tablwidth, i
    WU = usf.Width / Val(Split(usf.Tag, ":")(0)): HU = usf.Height / Val(Split(usf.Tag, ":")(1)) 'calcul du proprata
    For Each Ctrl In usf.Controls
        D = Split(Ctrl.Tag, ":")
        Ctrl.Move D(0) * WU, D(2) * HU, D(1) * WU, D(3) * HU 'redimentionnement par le prorata
        If UBound(Split(Ctrl.Tag, ":")) > 3 Then Ctrl.Font.Size = Round(D(4) * HU) + 1 'il il y a la propriété font on redimentionne le font
        If TypeName(Ctrl) = "ListBox" Then 'si c 'est une listbox on reconstruit le columnwidts avec l'array precédement memorisé dans le tag
            tablwidth = Split(D(5), "|")
            For i = 0 To UBound(tablwidth): tablwidth(i) = Val(tablwidth(i)) * WU: Next 'ON MET LES DIMENTIONS COLONNE A JOUR
            Ctrl.ColumnWidths = Join(tablwidth, " pt;") 'reconstruction du string columnwidths
        End If
    Next
End Sub

demo animé
Pièce jointe 277247
fichier démo en pièce jointe
Terminé

19/05/2017, 16h21
Apoulit

Re Patrcick un grand merci.... je regarde ça , j'essaye de comprendre , et je met ça en application si je peu :D ....

T'es vraiment sympa ;)
19/05/2017, 19h24
unparia

Bonjour
J'aurais préféré me taire, mais mon caractère est tel que je ne saurais cacher certaines vérités :
S'il est une erreur classique, c'est bien celle qui consiste à procéder de cette manière : --->>

- redimensionnements alors que certains éléments de ce que l'on redimensionne ne sauraient être eux-mêmes redimensionnés
- redimensionnement de taille de police de caractères par application du coefficient adopté pour redimensionner les contrôles et le UserForm eux-mêmes

On arrive ainsi, dans certains cas :
- dans le meilleur des cas à des pis-aller (et encore : à condition d'être très généreux dans les dimensions d'origine dont on dote les contrôles)
- dans le pire des cas : à des textes tronqués
- dans la plupart des cas : à la perte des proportions d'origine.

Je sais, patricktoulon, que mon intervention ne va pas te plaire, mais te prie de croire qu'elle a pour seul but celui d'éveiller et non de mettre en cause la qualité, en elle-même, de ton travail.
Accepte cette remarque et mon amitié.
19/05/2017, 20h34
patricktoulon

re

oui unparia je sais que pour les font c'est compliqué
je l'explique d'ailleurs dans les contributions qui parle de ce sujet

j'ai choisi de faire un coefficient par le height celui ci étant souvent plus petit que le width

reste en effet le cas ou le width deviens plus petit a une certaine taille forcement ca bouffe les caractères

c'est donc un compromis
19/05/2017, 23h02
unparia

Citation:

c'est donc un compromis

Qui peut avoir de très fâcheuses conséquences dans certains cas.
Et quid du redimensionnement de certains contrôles dont certains éléments ne sont pas redimensionnables ? (les ascenseurs d'une listbox, par exemple et entre autres)
En appliquant un coefficient correcteur aux dimensions de tels contrôles, il y a forcément un décalage très significatif en leur intérieur.

Je veux passer sous silence (d'accord car peu significatif ... sauf dans certains cas) les bordures de tous les contrôles. Hé oui, elles ne sont pas redimensionnables et faussent également les proportions de l'intérieur.

C'est là toute la différence entre le travail d'un véritable "resizer" et un code qui applique un coefficient aux dimensions, positions et tailles des polices de caractères. ;)

EDIT :

Citation:

reste en effet le cas ou le width deviens plus petit a une certaine taille forcement ca bouffe les caractères

n'a absolument rien à voir dans cette affaire.
Seuls sont concernés la police, sa taille et le coefficient (quel qu'il soit).
L'écran, sa résolution, etc ... n'ont AUCUN rôle dans cette erreur qui consiste à traiter de la même manière des choses distinctes.
12/06/2017, 15h25
Apoulit

Bonjour, désolé pour le retard pb de santé :(

Un grand merci à Patrick qui par sa contribution propose une solution qui fonctionne et sait plus qu'exploitable !!!