XL 2016 maximiser minimiser un UF

M

marc.gilliand

XLDnaute Occasionnel
Bonjour le Forum,
Dans le fichier jont, j'aimerai maximiser et minimiser mes UF's, quelque soit la taille et la résolution de l'écran. Bien évidemment en redimensionnant les objets, cela va sans dire.
Merci de me dire comment je dois utiliser le code que j'ai trouvé. Merci de votre aide.
 

Pièces jointes

  • Debtor_monitoring_03062021_1020_Envoir Forum (2).zip
    750.9 KB · Affichages: 8
  • minimiser-maximiser-uf-v2 (1).xlsm
    28 KB · Affichages: 4
Trier par date Trier par votes
patricktoulon

patricktoulon

XLDnaute Barbatruc
bonjour a tous
@cathodique la version que tu a n'est pas a jour
depuis j'ai ajouté le redim du columnwidths des listbox
VB: 
Private Sub UserForm_Activate()    'PatrickToulon code proposé dans initialize

'Plein Ecran UserForm
    Dim ctl As Control, ratioW#, ratioH#, wstate&, i&, ClW
    With Application: wstate = .WindowState: .WindowState = xlMaximized:
        ratioW = Application.Width / Me.Width
        ratioH = Application.Height / Me.Height
        .WindowState = wstate
    End With
'pour lexemple j'ajoute une lite box avec 2 colonnes    
'With ListBox1: .List = [A1:B5].Value: .ColumnCount = 2: .ColumnWidths = "30;60": End With '
    DoEvents
    With Me
        .StartUpPosition = 0: .Left = 0: .Top = 0
        .Width = (.Width * ratioW) - (.Width - .InsideWidth)
        .Height = (.Height * ratioH) - (.Height - .InsideHeight) + (.Width - .InsideWidth)
    End With
    For Each ctl In Me.Controls
        ctl.Move ctl.Left * ratioW, ctl.Top * ratioH, ctl.Width * ratioW, ctl.Height * ratioH
        Select Case TypeName(ctl)
        Case "TextBox", "Label", "Frame", "CommandButton", "MultiPage", "ListBox", "ComboBox", "CheckBox", "OptionButton"
            ctl.Font.Size = ctl.Font.Size * ratioH
        End Select
        If TypeName(ctl) = "ListBox" Then
            If ctl.ColumnWidths = "" Then ClW = Split(Trim(Application.Rept(70 & " ", ctl.ColumnCount)), " ") Else ClW = Split(Replace(ctl.ColumnWidths, " pt", ""), ";")
            For i = 0 To UBound(ClW): ClW(i) = Val(ClW(i)) * ratioW: Next
            ctl.ColumnWidths = Join(ClW, ";")
         End If
    Next
End Sub
;)
 
Vote positif 0 Vote négatif
M

marc.gilliand

XLDnaute Occasionnel
patricktoulon à dit:
bonjour a tous
@cathodique la version que tu a n'est pas a jour
depuis j'ai ajouté le redim du columnwidths des listbox
VB: 
Private Sub UserForm_Activate()    'PatrickToulon code proposé dans initialize

'Plein Ecran UserForm
    Dim ctl As Control, ratioW#, ratioH#, wstate&, i&, ClW
    With Application: wstate = .WindowState: .WindowState = xlMaximized:
        ratioW = Application.Width / Me.Width
        ratioH = Application.Height / Me.Height
        .WindowState = wstate
    End With
'pour lexemple j'ajoute une lite box avec 2 colonnes  
'With ListBox1: .List = [A1:B5].Value: .ColumnCount = 2: .ColumnWidths = "30;60": End With '
    DoEvents
    With Me
        .StartUpPosition = 0: .Left = 0: .Top = 0
        .Width = (.Width * ratioW) - (.Width - .InsideWidth)
        .Height = (.Height * ratioH) - (.Height - .InsideHeight) + (.Width - .InsideWidth)
    End With
    For Each ctl In Me.Controls
        ctl.Move ctl.Left * ratioW, ctl.Top * ratioH, ctl.Width * ratioW, ctl.Height * ratioH
        Select Case TypeName(ctl)
        Case "TextBox", "Label", "Frame", "CommandButton", "MultiPage", "ListBox", "ComboBox", "CheckBox", "OptionButton"
            ctl.Font.Size = ctl.Font.Size * ratioH
        End Select
        If TypeName(ctl) = "ListBox" Then
            If ctl.ColumnWidths = "" Then ClW = Split(Trim(Application.Rept(70 & " ", ctl.ColumnCount)), " ") Else ClW = Split(Replace(ctl.ColumnWidths, " pt", ""), ";")
            For i = 0 To UBound(ClW): ClW(i) = Val(ClW(i)) * ratioW: Next
            ctl.ColumnWidths = Join(ClW, ";")
         End If
    Next
End Sub
;)
Cliquez pour agrandir...
désolé, mais je ne suis pas assez doué pour savoir où et comment coller ce code dans mon fichier. Je ne comprends pas. Par rapport à mon fichier Debtor monitoring, comment dois-je utiliser ce code, ?
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
patricktoulon à dit:
bonjour a tous
@cathodique la version que tu a n'est pas a jour
depuis j'ai ajouté le redim du columnwidths des listbox
VB: 
Private Sub UserForm_Activate()    'PatrickToulon code proposé dans initialize

'Plein Ecran UserForm
    Dim ctl As Control, ratioW#, ratioH#, wstate&, i&, ClW
    With Application: wstate = .WindowState: .WindowState = xlMaximized:
        ratioW = Application.Width / Me.Width
        ratioH = Application.Height / Me.Height
        .WindowState = wstate
    End With
'pour lexemple j'ajoute une lite box avec 2 colonnes   
'With ListBox1: .List = [A1:B5].Value: .ColumnCount = 2: .ColumnWidths = "30;60": End With '
    DoEvents
    With Me
        .StartUpPosition = 0: .Left = 0: .Top = 0
        .Width = (.Width * ratioW) - (.Width - .InsideWidth)
        .Height = (.Height * ratioH) - (.Height - .InsideHeight) + (.Width - .InsideWidth)
    End With
    For Each ctl In Me.Controls
        ctl.Move ctl.Left * ratioW, ctl.Top * ratioH, ctl.Width * ratioW, ctl.Height * ratioH
        Select Case TypeName(ctl)
        Case "TextBox", "Label", "Frame", "CommandButton", "MultiPage", "ListBox", "ComboBox", "CheckBox", "OptionButton"
            ctl.Font.Size = ctl.Font.Size * ratioH
        End Select
        If TypeName(ctl) = "ListBox" Then
            If ctl.ColumnWidths = "" Then ClW = Split(Trim(Application.Rept(70 & " ", ctl.ColumnCount)), " ") Else ClW = Split(Replace(ctl.ColumnWidths, " pt", ""), ";")
            For i = 0 To UBound(ClW): ClW(i) = Val(ClW(i)) * ratioW: Next
            ctl.ColumnWidths = Join(ClW, ";")
         End If
    Next
End Sub
;)
Cliquez pour agrandir...
Allez hop! dans la tirelire. Merci beaucoup pour la mise à jour.
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
@cathodique
j'ai vu aussi que tu n'avais pas la bascule minimum pour le resize font
je vois aussi que le case n'est pas celui de la derniere version mais c'est moins grave (ajouter si besoins les controls manquants)
elle doit dater cette version ?
tenez prenez celle ci
VB: 
Private Sub UserForm_Activate()    'PatrickToulon code proposé dans initialize

'Plein Ecran UserForm
    Dim ctl As Control, ratioW#, ratioH#, wstate&, i&, ClW
    With Application: wstate = .WindowState: .WindowState = xlMaximized:
        ratioW = Application.Width / Me.Width
        ratioH = Application.Height / Me.Height
        .WindowState = wstate
    End With
    ' pour l'exemple j'ajoute une listbox avec 2 colonnes
   ' With ListBox1: .List = [A1:B5].Value: .ColumnCount = 2: .ColumnWidths = "30;60": End With
    DoEvents
    With Me
        .StartUpPosition = 0: .Left = 0: .Top = 0
        .Width = (.Width * ratioW) - (.Width - .InsideWidth)
        .Height = (.Height * ratioH) - (.Height - .InsideHeight) + (.Width - .InsideWidth)
    End With
    For Each ctl In Me.Controls
        ctl.Move ctl.Left * ratioW, ctl.Top * ratioH, ctl.Width * ratioW, ctl.Height * ratioH
        Select Case TypeName(ctl)
        Case "TextBox", "Label", "Frame", "CommandButton", "MultiPage", "ListBox", "ComboBox", "CheckBox", "OptionButton"
            ctl.Font.Size = ctl.Font.Size * Application.Min(ratioH, ratioW)
        End Select
       
        If TypeOf ctl Is msforms.ListBox Then
            If ctl.ColumnWidths = "" Then ClW = Split(Trim(Application.Rept(70 & " ", ctl.ColumnCount)), " ") Else ClW = Split(Replace(ctl.ColumnWidths, " pt", ""), ";")
            For i = 0 To UBound(ClW): ClW(i) = Val(ClW(i)) * ratioW: Next
            ctl.ColumnWidths = Join(ClW, ";")
         End If
    Next
End Sub
démo de l'original size
1622799495360.png

démo sans le resize du columnwidths des listbox
1622799424387.png


demo avec resize du columnwidths
1622799587494.png
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re ben vu le boulot qui a été fait sur ce fichier tu devrait savoir faire non?
c'est simple tu colle le code de l'event activate dans tout tes userforms que tu veux en plein écran
c'est pas compliqué
VB: 
Private Sub UserForm_Activate()    'PatrickToulon code proposé dans initialize

'Plein Ecran UserForm
    Dim ctl As Control, ratioW#, ratioH#, wstate&, i&, ClW
    With Application: wstate = .WindowState: .WindowState = xlMaximized:
        ratioW = Application.Width / Me.Width
        ratioH = Application.Height / Me.Height
        .WindowState = wstate
    End With
    DoEvents
    With Me
        .StartUpPosition = 0: .Left = 0: .Top = 0
        .Width = (.Width * ratioW) - (.Width - .InsideWidth)
        .Height = (.Height * ratioH) - (.Height - .InsideHeight) + (.Width - .InsideWidth)
    End With
    For Each ctl In Me.Controls
        ctl.Move ctl.Left * ratioW, ctl.Top * ratioH, ctl.Width * ratioW, ctl.Height * ratioH
        Select Case TypeName(ctl)
        Case "TextBox", "Label", "Frame", "CommandButton", "MultiPage", "ListBox", "ComboBox", "CheckBox", "OptionButton"
            ctl.Font.Size = ctl.Font.Size * Application.Min(ratioH, ratioW)
        End Select
        
        If TypeOf ctl Is msforms.ListBox Then
            If ctl.ColumnWidths = "" Then ClW = Split(Trim(Application.Rept(70 & " ", ctl.ColumnCount)), " ") Else ClW = Split(Replace(ctl.ColumnWidths, " pt", ""), ";")
            For i = 0 To UBound(ClW): ClW(i) = Val(ClW(i)) * ratioW: Next
            ctl.ColumnWidths = Join(ClW, ";")
         End If
    Next
End Sub
 
Vote positif 0 Vote négatif
M

marc.gilliand

XLDnaute Occasionnel
patricktoulon à dit:
re ben vu le boulot qui a été fait sur ce fichier tu devrait savoir faire non?
c'est simple tu colle le code de l'event activate dans tout tes userforms que tu veux en plein écran
c'est pas compliqué
VB: 
Private Sub UserForm_Activate()    'PatrickToulon code proposé dans initialize

'Plein Ecran UserForm
    Dim ctl As Control, ratioW#, ratioH#, wstate&, i&, ClW
    With Application: wstate = .WindowState: .WindowState = xlMaximized:
        ratioW = Application.Width / Me.Width
        ratioH = Application.Height / Me.Height
        .WindowState = wstate
    End With
    DoEvents
    With Me
        .StartUpPosition = 0: .Left = 0: .Top = 0
        .Width = (.Width * ratioW) - (.Width - .InsideWidth)
        .Height = (.Height * ratioH) - (.Height - .InsideHeight) + (.Width - .InsideWidth)
    End With
    For Each ctl In Me.Controls
        ctl.Move ctl.Left * ratioW, ctl.Top * ratioH, ctl.Width * ratioW, ctl.Height * ratioH
        Select Case TypeName(ctl)
        Case "TextBox", "Label", "Frame", "CommandButton", "MultiPage", "ListBox", "ComboBox", "CheckBox", "OptionButton"
            ctl.Font.Size = ctl.Font.Size * Application.Min(ratioH, ratioW)
        End Select
      
        If TypeOf ctl Is msforms.ListBox Then
            If ctl.ColumnWidths = "" Then ClW = Split(Trim(Application.Rept(70 & " ", ctl.ColumnCount)), " ") Else ClW = Split(Replace(ctl.ColumnWidths, " pt", ""), ";")
            For i = 0 To UBound(ClW): ClW(i) = Val(ClW(i)) * ratioW: Next
            ctl.ColumnWidths = Join(ClW, ";")
         End If
    Next
End Sub
Cliquez pour agrandir...
ok, merci très bien. Sauf qu'il me manque environ 2mm à gauche et à droite et 1mm en haut et en bas. Oû est-ce que je dois aller dans le code pour corriger cela ? Et pour le minimiser ?????
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
marc.gilliand à dit:
ok, merci très bien. Sauf qu'il me manque environ 2mm à gauche et à droite et 1mm en haut et en bas. Oû est-ce que je dois aller dans le code pour corriger cela ? Et pour le minimiser ?????
Cliquez pour agrandir...
Tu n'as rien à toucher au code de @patricktoulon . Il te suffit de supprimer cette procédure
VB: 
'Private Sub UserForm_Resize()
'Dim RtL As Single, RtH As Single
'    If Me.Width < 300 Or Me.Height < 200 Or Fini Then Exit Sub
'    RtL = Me.Width / Lg
'    RtH = Me.Height / Ht
'    Me.Zoom = IIf(RtL < RtH, RtL, RtH) * 100
'End Sub
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
et oui W10 et W7 n'ont pas les même mesures pour le shell et aero
il y a le fait aussi que W10 utilise + ces drivers graphiques génériques, que celui du fournisseur de la carte graphique
et puis c'est normal l'app excel en plein écran dépasse de 2 point environ l’écran et cela de part tout
et comme on dimensionne le usf par rapport a l'app il est normal que tu es des petites choses comme ça

alors c'est + ou - c'est toi qui voit
With Me
.StartUpPosition = 0: .Left = 0: .Top = 0
.Width = (.Width * ratioW) - (.Width - .InsideWidth) ' plus ou moins quelque chose ici
.Height =( (.Height * ratioH) - (.Height - .InsideHeight) + (.Width - .InsideWidth))' idem
End With
 
Vote positif 0 Vote négatif
M

marc.gilliand

XLDnaute Occasionnel
patricktoulon à dit:
re
a ben si il ajoute un redim dans l'event resize on s'en sort plus là
Cliquez pour agrandir...
ok, merci ça va très bien. Merci à tous les contributeurs.

Par rapport à mes autres questions, avez-vous quelques idées ? Pos à 0900 et quelque sujet : affichage ligne active dans divers UF's ?
Et surtout le sujet sur la petite fonction de recherche qu'il y dans mes UF's ? ça serait vraiment sympa si vous pouviez me trouver une solution.....
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
Microsoft 365 UserForm maximiser la taille du formulaire par rapport à la taille de l'écran
2
Réponses
22
Affichages
2 K
TooFatBoy
TooFatBoy
Z
  • Résolu(e)
Microsoft 365 Récupérer les éléments d'une liste en fonction de leur position
Réponses
2
Affichages
328
Zarnir
Z
G
  • Question
XL pour MAC Solveur : minimiser le nombre de lot à produire
Réponses
1
Affichages
542
Georges Van Bruggel
G
C
  • Question
XL 2016 Comment faire une fonction fréquence avec un critère de date
Réponses
3
Affichages
284
sylvanu
sylvanu
N
  • Question
Microsoft 365 Liste déroulante (combobox) en fonction d'une séquence de valeurs
Réponses
13
Affichages
364
Neofalken
N
Todre
  • Résolu(e)
Microsoft 365 Remplissage automatique d'une feuille à l'autre
2 3
Réponses
44
Affichages
2 K
Todre
Todre
M
  • Résolu(e)
Microsoft 365 Gestion numéros de pages du classeur dans une cellule
2
Réponses
16
Affichages
735
sousou
sousou
mapomme
  • Question
Microsoft 365 Formes, groupe de formes, groupe de groupes, etc.
2
Réponses
27
Affichages
685
Aeggie78
A
B
  • Question
XL 2013 Automatiser une formule sur les nouvelles lignes insérées en fonction d'une recherche sur les enregistrements
Réponses
9
Affichages
297
bedley
B
Gen Rose
  • Résolu(e)
Microsoft 365 Reporter une valeur selon un critère qui a un critère
Réponses
9
Affichages
387
Gen Rose
Gen Rose

Membres actuellement en ligne

2 membres et 49 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 793
Messages
2 092 157
Membres
105 241
dernier inscrit
Mixlsm