Microsoft 365 Adapter USF a tout écran

[Marec]

Bonsoir a tous et a toutes

Malgré mes essais,en piochant dans dans des applis du forum,je ne parviens pas à faire fonctionner.
Je souhaiterais que le fichier que je mets a Disposition a un certains nombre d'utilisateurs,puisse s'afficher en plein écran pour chacun...et bien sûr les écrans des collaborateurs ne sont pas de taille identiques
A aujourd'hui,certains ont la page d'accueil tronquée et le USF incomplet.

Dans le fichier il y a un code ,mais il ne doit pas être où il faut ,ou je ne l'ai pas adapté au mieux

D'avance merci pour votre aide que ce problème.

 

[vgendron]

Hello

je suis à peu près sur qu'il y a dans les ressources du forum une appli qui permet de redimmensionner un formulaire (avec tous ses controls) à la taille de la fenetre... mais je ne la retrouve pas...
de mémoire c'est un travail de @patricktoulon ??

 

[Marec]

Bonsoir Vgendron,

Il y a quelques sujets similaires oui.
Dans mon cas la page d'accueil est importante mais certains qui l'utilisent ne voient pas tout.Ce qui est gênant puisqu'il y a quelques boutons.
Ensuite le USF est tronqué également .!!
J'ai bien quelques codes mais je ne parviens pas a adapter.

Je vais poursuivre mes recherches
Merci

 

[vgendron]

je viens de retrouver son code que j'ai utilisé dans une de mes appli

'**********************************************************************************************************************
'*                                     CREATEUR :Patrick toulon Alias chamalin1@msn.com                               *
'*                                                    DATE :23/09/2010                                                *
'*                                       UTILISATION D'UNE SEULE API LE "USER32.DLL"                                  *
'*                                    EXEMPLE DE USERFORM REDIMENSIONNABLE NOUVELLE VERSION                           *
'*                                      LES CONTROLS SONT REDIMENSIONNES 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é contrôle par contrôle ,ils peuvent donc avoir un fontsize différent                           *
'*                                                                                                                    *
'**********************************************************************************************************************
Option Explicit
Public Declare Function FWA Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SWH Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function SWLA Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GWLA Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public old_largeur As Long, handle As Long, old_hauteur As Long, newhauteur As Single, newlargeur As Single
Dim Ctl As Object
Dim ctrl As Object

Sub trois_boutons(uf As Object)    'on va ajouter les deux boutons manquants et l'élasticité à l'userform
'*******************************************************************
'*ici on mémorise les dimention de départ de l'userform            *
    old_largeur = uf.InsideWidth: old_hauteur = uf.InsideHeight   '*
'*******************************************************************

'*******************************************************************************************************************
'nouvelle version                                                                                                  *
' ici on va mémoriser l'opérateur corespondant à l'userform / par le font size de chaque contrôle _                *
'  sauf ceux qui n'ont pas cette propriété                                                                         *
    For Each ctrl In uf.Controls                                                                                  '*
        If TypeName(ctrl) <> "ScrollBar" And TypeName(ctrl) <> "Image" And TypeName(ctrl) <> "SpinButton" Then    '*
            ctrl.Tag = uf.InsideWidth / ctrl.Font.Size                                                            '*
        End If                                                                                                    '*
    Next                                                                                                          '*
    '***************************************************************************************************************

    '***************************************************************************************************************
    ' ici on détermine le handle par la classe de frame en testant la version de l'application ( DE EXCEL97 A 2010)*
    handle = FWA("Thunder" & IIf(Application.Version Like "8*", "0*", "D") & "Frame", uf.Caption)                 '*
    ' ici on applique les changement (&h70000= les trois bouton et l'elasticité)                                   *
    SWLA handle, -16, GWLA(handle, -16) Or &H70000                                                                '*
    '***************************************************************************************************************


End Sub
Sub plein_ecran()
' on affiche le userform en plein écran avec l'api showwindowa de la user32.dll _
  bien moins lourd que mes versions précédentes de maximisation de l'userform et plus rapide et plus propre
'1= mode normal
'3 =maximiser
'6 =minimiser
'le handle a été declaré en public au début du module et identifié dans la routine des trois boutons, il n'est donc plus nécessaire de l'identifier
    SWH handle, 3
End Sub

Sub maForm_Resize(usf As Object)
'ici on détermine le multiplicateur qui différencie la dimention de base à celle actuelle de l'userform
    newlargeur = usf.InsideWidth / old_largeur: newhauteur = usf.InsideHeight / old_hauteur

    'ici on boucle sur tous les contrôles
    For Each Ctl In usf.Controls
        'et on applique le multiplicateur au contrôles pour la largeur et la hauteur en une seule ligne
        Ctl.Move Ctl.Left * newlargeur, Ctl.Top * newhauteur, Ctl.Width * newlargeur, Ctl.Height * newhauteur
        'tout les contrôles qui ont le multiplicateur enregistré dans leurs tags respectifs verront leur font size redimentionné en proportion
          If Ctl.Tag <> "" Then Ctl.Font.Size = Round(usf.InsideWidth / Ctl.Tag, 0) - 1
    Next
    'ici on indique que l'ancienne largeur devient la nouvelle largeur et pareil pour la hauteur indispensable pour un futur redimensionnement
    old_largeur = usf.InsideWidth: old_hauteur = usf.InsideHeight: usf.Repaint
End Sub


'***************************Ajouter les 2 lignes de codes suivantes en fin de "Nomformulaire_Activate"************************************
'    trois_boutons Me 'on rajoute les 2 boutons Maximiser et Minimiser le formulaire et l'élasticité permettant le redimensionnement (voir code dans le module USF_redimensionnable)
'    plein_ecran 'et on affiche le formulaire en plein écran
'*****************************************************************************************************************************************

'*****************Ajouter le code pour le Userform_Resize*********************************************************************************
'Private Sub UserForm_Resize() 'quand le formulaire est redimensionné
'maForm_Resize Me ' redimensionnement de tous les contrôles présents dans le formulaire (voir code dans le module USF_redimensionnable)
'End Sub
'*****************************************************************************************************************************************

à mettre dans un module standard
et faire ce qui est écrit tout en bas: ajouter les 2 lignes de code dans l'évènement _activate du formulaire
et ajouter l'évènement _resize

 

[Marec]

Heuuu...ya du level dans ce genre de code!!!
La page d'accueil ,y a t il moyen d'adapter aux différents écrans ?
Merci pour votre aide et votre recherche rapide,ceci dit,je souhaiterais éviter d'ajouter des boutons .
Les utilisateurs risquent de ne pas apprécier des manipulations supplémentaires

 

[patricktoulon]

Bonjour
punaise il est vieux celui là de code
attention celui là est fait pour adapter a l’écran mais n'est pas vraiment prévu pour le resize dynamique avec la souris
punaise 2010
me semble t il si on cherche bien même ici sur xld j'ai fait plus abordable pour les non initiés

 

[jurassic pork]

Hello,

punaise il est vieux celui là de code

Il est vieux mais il a toujours l'air de fonctionner en l'adaptant aux versions modernes d'Excel (VBA7 et 64 bits)
Voici les déclarations qu'il faut changer pour que cela fonctionne en 64 bits et Excel >= 2010 :

Option Explicit
#If VBA7 Then
    #If Win64 Then
        Public Declare PtrSafe Function GWLA Lib "USER32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Public Declare PtrSafe Function SWLA Lib "USER32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Public Declare PtrSafe Function GWLA Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
        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
    Public Declare Function GWLA Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Public Declare Function SWLA Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If

#If VBA7 Then
    Public Declare PtrSafe Function FWA Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Public Declare PtrSafe Function SWH Lib "USER32" Alias "ShowWindow" (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Long
#Else
    Public Declare Function FWA Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Public Declare Function SWH Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
#End If
#If VBA7 Then
   Public handle As LongPtr
#Else
   Public handle As Long
#End If
Public old_largeur As Long, old_hauteur As Long, newhauteur As Single, newlargeur As Single
Dim Ctl As Object, ctrl As Object

Cette partie fonctionne chez moi en Excel 2021 64 bits avec le classeur de Marec.
A ajouter dans le code du formulaire de Marec comme l'indique vgendron :

Private Sub UserForm_Activate()
trois_boutons Me
plein_ecran
End Sub

Private Sub UserForm_Resize()
maForm_Resize Me
End Sub

J'ai testé avec une résolution écran de 1024x768 , le texte dans le formulaire est toujours lisible.
A noter que je n'ai pas testé avec du excel 32 bits et du excel < 2010 , il peut y avoir des erreurs dans les
déclarations d' API pour ces versions.
Ami calmant, J.P

 

[patricktoulon]

re
bonjour @jurassic pork
perso je me sert des api en macro 4 pour ce petit travail de resize
il faut débloquer les macro 4 dans les options excel 2019 et+
ou alors le faire avec les api déclarées en bon et due forme

et mes versions plus récentes sont plus complètes au niveau du resize
y compris les columnwidths des listboxs et le font

dans un module standard

'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'                            Module RESIZER  userform version basic
'version  avec api en macro 4
'release 2020  for XLD
'****************************************************************************************************
Option Explicit

Dim OldW#, OldH#
Sub trois_boutons() 'ajoute les 3 boutons et le resize dynamique à l'userform
    Dim hwnd&
    hwnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")") 'api GetActiveWindow
    ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & hwnd & ", " & -16 & ", " & &H94CF0080 & ")") 'api SetWindowLongA
End Sub

Sub UsfFullScreen() 'met le userform en plein ecran
    Dim hwnd&
    hwnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")") 'api GetActiveWindow
    ExecuteExcel4Macro ("CALL(""user32"",""ShowWindow"",""JJJ""," & hwnd & ", 3)") 'api SetWindowLongA
End Sub

Sub memoControlSize(usf) 'on memorise dans le tag des controls leur position et dimension
    Dim CtrL
    OldW = usf.Width
    OldH = usf.Height
    For Each CtrL In usf.Controls
        CtrL.Tag = CtrL.Left & ";" & CtrL.Top & ";" & CtrL.Width & ";" & CtrL.Height
        On Error Resume Next
        CtrL.Tag = CtrL.Tag & ";" & CtrL.Font.Size
        CtrL.Tag = CtrL.Tag & ";"
        Err.Clear: On Error GoTo 0
        If TypeName(CtrL) = "ListBox" Or TypeOf CtrL Is ListBox Then
            CtrL.Tag = CtrL.Tag & ";" & Replace(CtrL.ColumnWidths, ";", "|")
        End If
        CtrL.Tag = CtrL.Tag & ";"
    Next
End Sub

Sub resiZer(usf)
    Dim newW#, NewH#, t, cw$, tc, CtrL, i&
    newW = usf.Width / OldW
    NewH = usf.Height / OldH
    For Each CtrL In usf.Controls
        t = Split(CtrL.Tag, ";")
        CtrL.Move t(0) * newW, t(1) * NewH, t(2) * newW, t(3) * NewH
        If TypeName(CtrL) = "ListBox" Or TypeOf CtrL Is ListBox Then
            If CtrL.ColumnWidths = "" Then cw = Application.Rept("80", CtrL.ColumnCount) Else cw = CtrL.ColumnWidths
            tc = Split(t(6), "|")
            For i = 0 To UBound(tc): tc(i) = Val(tc(i)) * Application.Min(newW, NewH): Next
            CtrL.ColumnWidths = Join(tc, ";")
        End If
        On Error Resume Next
        CtrL.Font.Size = t(4) * Application.Min(newW, NewH)
        Err.Clear: On Error GoTo 0
    Next
End Sub

et dans le userform

Private Sub UserForm_Activate()
    trois_boutons
    memoControlSize Me
    UsfFullScreen
End Sub


Private Sub UserForm_Resize()
    resiZer Me
End Sub

voilà

 

[patricktoulon]

je vous met un fichier exemple

 

[jurassic pork]

perso je me sert des api en macro 4 pour ce petit travail de resize

Super, je ne connaissais pas cette astuce et cela semble fonctionner avec du Excel 64 bits.
En pièce jointe le classeur de Marec avec ton code , qui fonctionne chez moi en Excel 2021 64 bits.

 

[patricktoulon]

re
bien sur que ça fonctionne

si cela t’intéresse

démonstration de l'utilisation des api en Excelmacro4 épisode 1 la barre de titre des userforms

UTILISATION DES API AVEC EXECUTEEXCEL4MACRO ÉPISODE 1 très souvent on peine a déclarer nos api en fonction de la version d'excel 32/64 bits ce fichier vous montre un certain nombre de possibilités quand à l'utilisation des api avec...

excel-downloads.com

démonstration de l'utilisation des api en Excelmacro4 episode 2 les frames transparentes

la transparence des frames Bonjour à tous je continu dans la démonstration d'utilisation des api avec executeexcel4macro dans cet épisode on va rendre les frames transparentes comme dans l'épisode 1 on a pas de déclaration d'api a faire...

excel-downloads.com

démonstration de l'utilisation des api en Excelmacro4 episode 3 la transparence dans userform

De la transparence dans les Userforms en utilisant les apis en macro 4 Bonjour à tous je continu dans la démonstration d'utilisation des api avec executeexcel4macro dans cet épisode vous trouverez comment jouer avec la transparence pour les...

excel-downloads.com

démonstration de l'utilisation des api en Excelmacro4 episode 4 diverses fonctions

diverses fonctions ou Sub utilisant les apis en macro 4 Bonjour à tous je continu dans la démonstration d'utilisation des api avec executeexcel4macro dans cet épisode vous trouverez diverses fonctions notamment la "pointtopixel "avec la...

excel-downloads.com

 

[Marec]

Bonjour a tous,

Je vois je les échanges vont bon train.
De mon côté, suis en réunion je regarde a toutes vos propositions dès que possible
Je vous informe dès ce que vais découvrir parmi vos propositions

Merci

 

[Marec]

Bonjour a tous,

j'ai pu profiter de vos de vos connaissances, sans bien comprendre tout ce qui é été fait
En tout cas le plein écran fonctionne sur les différents écrans que j'ai pu tester.
Néanmoins, je n'ai plus l'annulation des filtres comme c'était auparavant
Pourtant les codes sont toujours bien dans les modules ??
si vous pouvez m'éclairer encore la dessus

merci d'avance

 

[patricktoulon]

Bonjour @Marec
quel rapport ça a avec l'userform plein écran??

 

[Marec]

Bonjour Patricktoulon,

En fait,dans la Bdd les tris sont possibles pour les utilisateurs via les macro en page d'accueil.
Seulement si les tris restaient actifs et qu'une saisi avec le USF était faite, alors l'enregistrement ne se faisait pas a la dernière ligne de la Bdd.
D'ou les codes pour annuler les tri dés qu'on fait appel au formulaire
Depuis l'intégration du code plein écran,l'annulation des tri n'est plus fonctionnel
Ya t il un conflit quelque part ??
A ce niveau là je ne sais pas du tout