Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

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
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

XLDnaute Barbatruc
Allez hop! dans la tirelire. Merci beaucoup pour la mise à jour.
 
Vote positif 0 Vote négatif

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

démo sans le resize du columnwidths des listbox


demo avec resize du columnwidths
 
Vote positif 0 Vote négatif

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
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

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

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
Identifiez-vous ou inscrivez-vous pour participer.

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
N
  • Question
Microsoft 365 appel des sous-routine
Réponses
3
Affichages
204
Dranreb
Z
  • Résolu(e)
Microsoft 365 Récupérer les éléments d'une liste en fonction de leur position
Réponses
2
Affichages
540
Zarnir
Z
L
  • Résolu(e)
Microsoft 365 Aide : Colorer une cellule en fonction de sa valeur
Réponses
2
Affichages
325
Leo98
L
G
  • Question
XL pour MAC Solveur : minimiser le nombre de lot à produire
Réponses
1
Affichages
676
Georges Van Bruggel
G
H
  • Résolu(e)
Microsoft 365 Packing list automatisée
Réponses
10
Affichages
751
HugoLaChips
H
C
  • Question
XL 2016 Comment faire une fonction fréquence avec un critère de date
Réponses
3
Affichages
511
sylvanu
N
  • Question
Microsoft 365 Liste déroulante (combobox) en fonction d'une séquence de valeurs
Réponses
13
Affichages
528
Neofalken
N
C
  • Question
XL 2021 Dupliquer un fichier selon une liste déroulante
Réponses
2
Affichages
209
catdog
C
  • Question
XL 2019 Tirage au sort avec nombre variable
Réponses
14
Affichages
539
Frederic14
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…