XL 2010 Userform Plein Ecran VBA7

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

cathodique

XLDnaute Barbatruc
Bonjour la communauté,

J'ai besoin de votre aide. Merci à celles et ceux qui ont Windows 10 64 bits et Excel 2019 64 bits de tester l'affichage en plein écran d'un userform.

La procédure ci-dessous avait été proposée, si mes souvenirs sont bons par @patricktoulon ,

je n'ai modifié que la partie haute mais ne fonctionne pas sous: Windows 10 64 bits et Excel 2019 64 bits.

Auriez-vous une solution à me proposer?
VB:
Option Explicit

#If VBA7 Then
    #If Win64 Then
        Public Declare PtrSafe Function SetWindowLongA Lib "user32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Public Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
        Public Declare PtrSafe Function GetWindowLongA Lib "user32" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Long
    #Else
        Public Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Public Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
        Public Declare PtrSafe Function GetWindowLongA Lib "user32" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
        Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Long
    #End If
#Else
    ' Pour Excel 2007 ou antérieur (VBA6)
    Public Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Public Declare Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If

Public Sub SameSizeApplication(Usf As Object)   'utilisé
   Dim ctl As Control, ratioW#, ratioH#, tbCw, i&

   With Application: ratioW = .UsableWidth / Usf.Width: ratioH = .Height / Usf.Height: End With
   Usf.Move 0, 0, Usf.Width * ratioW, Usf.Height * ratioH

   For Each ctl In Usf.Controls
      ctl.Move ctl.Left * ratioW, ctl.Top * ratioH, ctl.Width * ratioW, ctl.Height * ratioH
      On Error Resume Next
      ctl.Font.Size = Round(ctl.Font.Size * Application.Min(ratioH, ratioW))
      On Error GoTo 0

      If TypeName(ctl) = "ListBox" Or TypeOf ctl Is ListBox Then
         If ctl.ColumnWidths <> "" Then
            tbCw = Split(Replace(ctl.ColumnWidths, " pt", ""), ";")
            For i = LBound(tbCw) To UBound(tbCw): tbCw(i) = val(tbCw(i)) * ratioW: Next
            ctl.ColumnWidths = Join(tbCw, ";")
         End If
      End If
   Next
End Sub

Public Sub ShowFullScreenUserForm(Usf As Object)  ''ok'utilisé
   Dim hWnd As Long
   ' Ajuster les contrôles en fonction du nouveau format
   SameSizeApplication Usf

   hWnd = FindWindowA(vbNullString, Usf.Caption) 'plante ici
   ' Mettre le UserForm en plein écran sans barre de titre
   SetWindowLongA hWnd, -16, &H94080080
   '   ShowWindow hwnd, 3
End Sub
 

Pièces jointes

Solution
sinon
si tu veux un fullscreen fixe avec resize des controls tout totomatic avec showwindow sans déclaration d'api
ben tu le fait avec les macro4(activer les macro4 à partir de 2021 dans les options excel)
un module resize standard
VB:
'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //...
re
il y a tellement de manière assez simple de faire ça et j'en ai montré quelques unes ainsi que d'autres camarades du forum
et cela ; avec ou sans api
ce qu'il faut prendre en compte visiblement dans ton exercice d'aujourd'hui ,c'est le partage du fichier .
Ce qui implique une (retro)-compatibilité
après c'est un choix de style de code en fait
il faudrait peut être commencer a te faire des petits ruchs cathodique à fin d'utiliser et maitriser une méthode ou une autre
(celle qui te plaira bien)
depuis le temps que tu bricole avec tes userforms (plein écran/sans barre de titre /etc..), tu devrais à minima maitriser les fonctions basiques de la librairie "user32" les plus rependues dans les codes VBA

GetActiveWindow
FindWindowA
GetWindowLongA
SetWindowLongA
ShowWindow
attention ,je ne critique personne, je te donne juste des axes de travail à retenir
pour le coup je t'ai fait un petit module a des fin tutorielle et même utilisable
pour que tu puisse t'entrainer en modifiant les constantes ,dans le set windowlong ou showwindow

c'est la base de chez base
VB:
'module utilitaire api de base a fin tutorielle
'auteur : patricktoulon
'pour @catodique

'1 GetActiveWindow 'cette fonction est sensée renvoyer un pointeur (une address memoire de la fenêtre)
'2 FindWindowA ' cette fonction est sensé trouver le pointeur dans la pile windows par sa classe ou titre ou les deux
'3 GetWindowLongA  'cette fonction est sensé  recupérer le poniteur des paramètre d'une window(sous 3 trame(-8 /-16/-20)
'4 SetWindowLongA'cette fonction c'est l'inverse elle applique les paramètres par contre uniquement sous les deux trames(-16/-20)
'5 ShowWindow' affiche la fenêtre apvec le parametre ecran (taille fentre et activation(focused)

'ces 5 api de base travaillent avec  un pointeur
'donc en 32 c'est un long(voir longptr en vba7)  et en 64 c'est un longptr
'ce qui implique que la variable pour le pointeur doit être dimensionnée sous les deux formes si on veut la full compatibilité(32/64)


#If VBA7 Then 'declaration vba7(32/64 bits)
    
    Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal HwnD As LongPtr, ByVal nIndex As Long) As Long
    Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HwnD As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    Declare PtrSafe Function ShowWindow Lib "user32" (ByVal HwnD As LongPtr, ByVal nCmdShow As Long) As Long
    
    Dim HwnD As LongPtr
    
#Else 'déclaration vb6(office 32 compatible(2007/2010/2013)
    
    Declare Function GetActiveWindow Lib "user32" () As Long
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal HwnD As Long, ByVal nIndex As Long) As Long
    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HwnD As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Declare Function ShowWindow Lib "user32" (ByVal HwnD As Long, ByVal nCmdShow As Long) As Long
    
    Dim HwnD As Long
#End If

Dim paramActuel As Long
'--- Constantes de styles de fenêtre (WS_*) pour la barre de titre et boutons ---argument( dwNewLong )dans la SetWindowLong
Const WS_CAPTION = &HC00000 ' Barre de titre (inclut WS_BORDER)
Const WS_SYSMENU = &H80000 ' Bouton "Fermer" (croix), nécessaire pour afficher menu système
Const WS_MINIMIZEBOX = &H20000 ' Bouton Réduire
Const WS_MAXIMIZEBOX = &H10000 ' Bouton Agrandir
Const WS_THICKFRAME = &H40000 ' Bordure redimensionnable (resize possible)
Const WS_BORDER = &H800000 ' Bordure simple (inclus si WS_CAPTION)
Const WS_OVERLAPPED = &H0 ' Fenêtre simple (par défaut)
Const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU _
    Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX

'--- Constantes ShowWindow (nCmdShow) ---
Const SW_HIDE As Long = 0 ' Cache la fenêtre
Const SW_SHOWNORMAL As Long = 1 ' Affiche normalement, restaure si minimisée
Const SW_NORMAL As Long = 1 ' Alias de SW_SHOWNORMAL
Const SW_SHOWMINIMIZED As Long = 2 ' Affiche la fenêtre réduite (icône)
Const SW_SHOWMAXIMIZED As Long = 3 ' Affiche la fenêtre agrandie (plein écran)
Const SW_MAXIMIZE As Long = 3 ' Alias
Const SW_SHOWNOACTIVATE As Long = 4 ' Affiche la fenêtre mais sans l’activer
Const SW_SHOW As Long = 5 ' Affiche la fenêtre, activée
Const SW_MINIMIZE As Long = 6 ' Réduit la fenêtre, active la suivante
Const SW_SHOWMINNOACTIVE As Long = 7 ' Réduit mais sans activer la fenêtre
Const SW_SHOWNA As Long = 8 ' Affiche dans son état actuel, sans activer
Const SW_RESTORE As Long = 9 ' Restaure si minimisée/maximisée
Const SW_SHOWDEFAULT As Long = 10 ' Utilise le paramètre de démarrage (STARTUPINFO)
Const SW_FORCEMINIMIZE As Long = 11 ' Force réduction même si la fenêtre n’accepte pas
'c'est les mêmes pour le 32 et 64


'-----------------------------------------------------
'pour commencer on travaillera avec le style(trame2) classique  donc -16
'-----------------------------------------------------
'LES 3 subs ou fonctions QUi sont faciles à maitriser

'1 °
Sub TroisBoutonsSurCaption(barredetitre As String)
    
    HwnD = FindWindow(vbNullString, barredetitre) ' donc on cherche le pointeur qui correspond a la poignée(handle) de la fentre ayant ce texte
    
    paramActuel = GetWindowLong(HwnD, -16) 'on recupère les paramètres actuels
    
    'ici on ava ajouter les deux boutons manquants et l'elasticité grace au operateurs logique (And,and not ,or ) et non mathématique
    SetWindowLong HwnD, -16, paramActuel Or WS_OVERLAPPEDWINDOW ' la totale reduire agrandir fermer elasticité
    
    '--- quelques exemples d'uilisation basique de chez basique
    ' Enlever bouton Réduire      -> paramActuel And Not WS_MINIMIZEBOX
    ' Enlever bouton Agrandir     -> paramActuel And Not WS_MAXIMIZEBOX
    ' Enlever les deux            -> paramActuel And Not (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
    ' Enlever resize (drag bord)  -> paramActuel And Not WS_THICKFRAME
    ' Remettre les deux boutons   -> paramActuel Or (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
    ' Tout bloquer sauf Fermer    -> WS_CAPTION Or WS_SYSMENU
End Sub


'2 °
Sub FenetreActiveFullScreen()
    HwnD = GetActiveWindow 'donne la poignée(le pointeur de la fenêtre active )ça peut être le userform
    ShowWindow HwnD, 3 '3plein ecran
End Sub


'3 °
'on envoie le texte de la caption en paramètre
Sub UserFormFullScreen(barredetitre As String)
    'vbnullstring par ce que on cherche la fenêtre avec le titre de la barre
    'attention cependant on peut tres bien avoir deux fenêtres avec le même titre la classe peut être utile pour les différencier
    HwnD = FindWindow(vbNullString, barredetitre) ' donc le pointeur
    ShowWindow HwnD, 3 '3plein ecran
End Sub
je te l'ai mis dans un fichier pour que tu n'ai pas a le refaire avec un userform fonctionnel
allez amuse toi 😉
 

Pièces jointes

re
il y a tellement de manière assez simple de faire ça et j'en ai montré quelques unes ainsi que d'autres camarades du forum
et cela ; avec ou sans api
ce qu'il faut prendre en compte visiblement dans ton exercice d'aujourd'hui ,c'est le partage du fichier .
Ce qui implique une (retro)-compatibilité
après c'est un choix de style de code en fait
il faudrait peut être commencer a te faire des petits ruchs cathodique à fin d'utiliser et maitriser une méthode ou une autre
(celle qui te plaira bien)
depuis le temps que tu bricole avec tes userforms (plein écran/sans barre de titre /etc..), tu devrais à minima maitriser les fonctions basiques de la librairie "user32" les plus rependues dans les codes VBA

GetActiveWindow
FindWindowA
GetWindowLongA
SetWindowLongA
ShowWindow
attention ,je ne critique personne, je te donne juste des axes de travail à retenir
pour le coup je t'ai fait un petit module a des fin tutorielle et même utilisable
pour que tu puisse t'entrainer en modifiant les constantes ,dans le set windowlong ou showwindow

c'est la base de chez base
VB:
'module utilitaire api de base a fin tutorielle
'auteur : patricktoulon
'pour @catodique

'1 GetActiveWindow 'cette fonction est sensée renvoyer un pointeur (une address memoire de la fenêtre)
'2 FindWindowA ' cette fonction est sensé trouver le pointeur dans la pile windows par sa classe ou titre ou les deux
'3 GetWindowLongA  'cette fonction est sensé  recupérer le poniteur des paramètre d'une window(sous 3 trame(-8 /-16/-20)
'4 SetWindowLongA'cette fonction c'est l'inverse elle applique les paramètres par contre uniquement sous les deux trames(-16/-20)
'5 ShowWindow' affiche la fenêtre apvec le parametre ecran (taille fentre et activation(focused)

'ces 5 api de base travaillent avec  un pointeur
'donc en 32 c'est un long(voir longptr en vba7)  et en 64 c'est un longptr
'ce qui implique que la variable pour le pointeur doit être dimensionnée sous les deux formes si on veut la full compatibilité(32/64)


#If VBA7 Then 'declaration vba7(32/64 bits)
   
    Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal HwnD As LongPtr, ByVal nIndex As Long) As Long
    Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HwnD As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    Declare PtrSafe Function ShowWindow Lib "user32" (ByVal HwnD As LongPtr, ByVal nCmdShow As Long) As Long
   
    Dim HwnD As LongPtr
   
#Else 'déclaration vb6(office 32 compatible(2007/2010/2013)
   
    Declare Function GetActiveWindow Lib "user32" () As Long
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal HwnD As Long, ByVal nIndex As Long) As Long
    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HwnD As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Declare Function ShowWindow Lib "user32" (ByVal HwnD As Long, ByVal nCmdShow As Long) As Long
   
    Dim HwnD As Long
#End If

Dim paramActuel As Long
'--- Constantes de styles de fenêtre (WS_*) pour la barre de titre et boutons ---argument( dwNewLong )dans la SetWindowLong
Const WS_CAPTION = &HC00000 ' Barre de titre (inclut WS_BORDER)
Const WS_SYSMENU = &H80000 ' Bouton "Fermer" (croix), nécessaire pour afficher menu système
Const WS_MINIMIZEBOX = &H20000 ' Bouton Réduire
Const WS_MAXIMIZEBOX = &H10000 ' Bouton Agrandir
Const WS_THICKFRAME = &H40000 ' Bordure redimensionnable (resize possible)
Const WS_BORDER = &H800000 ' Bordure simple (inclus si WS_CAPTION)
Const WS_OVERLAPPED = &H0 ' Fenêtre simple (par défaut)
Const WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU _
    Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX

'--- Constantes ShowWindow (nCmdShow) ---
Const SW_HIDE As Long = 0 ' Cache la fenêtre
Const SW_SHOWNORMAL As Long = 1 ' Affiche normalement, restaure si minimisée
Const SW_NORMAL As Long = 1 ' Alias de SW_SHOWNORMAL
Const SW_SHOWMINIMIZED As Long = 2 ' Affiche la fenêtre réduite (icône)
Const SW_SHOWMAXIMIZED As Long = 3 ' Affiche la fenêtre agrandie (plein écran)
Const SW_MAXIMIZE As Long = 3 ' Alias
Const SW_SHOWNOACTIVATE As Long = 4 ' Affiche la fenêtre mais sans l’activer
Const SW_SHOW As Long = 5 ' Affiche la fenêtre, activée
Const SW_MINIMIZE As Long = 6 ' Réduit la fenêtre, active la suivante
Const SW_SHOWMINNOACTIVE As Long = 7 ' Réduit mais sans activer la fenêtre
Const SW_SHOWNA As Long = 8 ' Affiche dans son état actuel, sans activer
Const SW_RESTORE As Long = 9 ' Restaure si minimisée/maximisée
Const SW_SHOWDEFAULT As Long = 10 ' Utilise le paramètre de démarrage (STARTUPINFO)
Const SW_FORCEMINIMIZE As Long = 11 ' Force réduction même si la fenêtre n’accepte pas
'c'est les mêmes pour le 32 et 64


'-----------------------------------------------------
'pour commencer on travaillera avec le style(trame2) classique  donc -16
'-----------------------------------------------------
'LES 3 subs ou fonctions QUi sont faciles à maitriser

'1 °
Sub TroisBoutonsSurCaption(barredetitre As String)
   
    HwnD = FindWindow(vbNullString, barredetitre) ' donc on cherche le pointeur qui correspond a la poignée(handle) de la fentre ayant ce texte
   
    paramActuel = GetWindowLong(HwnD, -16) 'on recupère les paramètres actuels
   
    'ici on ava ajouter les deux boutons manquants et l'elasticité grace au operateurs logique (And,and not ,or ) et non mathématique
    SetWindowLong HwnD, -16, paramActuel Or WS_OVERLAPPEDWINDOW ' la totale reduire agrandir fermer elasticité
   
    '--- quelques exemples d'uilisation basique de chez basique
    ' Enlever bouton Réduire      -> paramActuel And Not WS_MINIMIZEBOX
    ' Enlever bouton Agrandir     -> paramActuel And Not WS_MAXIMIZEBOX
    ' Enlever les deux            -> paramActuel And Not (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
    ' Enlever resize (drag bord)  -> paramActuel And Not WS_THICKFRAME
    ' Remettre les deux boutons   -> paramActuel Or (WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
    ' Tout bloquer sauf Fermer    -> WS_CAPTION Or WS_SYSMENU
End Sub


'2 °
Sub FenetreActiveFullScreen()
    HwnD = GetActiveWindow 'donne la poignée(le pointeur de la fenêtre active )ça peut être le userform
    ShowWindow HwnD, 3 '3plein ecran
End Sub


'3 °
'on envoie le texte de la caption en paramètre
Sub UserFormFullScreen(barredetitre As String)
    'vbnullstring par ce que on cherche la fenêtre avec le titre de la barre
    'attention cependant on peut tres bien avoir deux fenêtres avec le même titre la classe peut être utile pour les différencier
    HwnD = FindWindow(vbNullString, barredetitre) ' donc le pointeur
    ShowWindow HwnD, 3 '3plein ecran
End Sub
je te l'ai mis dans un fichier pour que tu n'ai pas a le refaire avec un userform fonctionnel
allez amuse toi 😉
Bonjour Patrick,

J’apprécie beaucoup ton sens du partage. De ce côté, tout est à ton honneur.

Nous n'avons pas tous le même niveau intellectuel, de plus chacun de nous est doué pour telle ou telle autre chose.

Je ne suis pas spécialement doué pour le développement. Cependant, on me reconnait ma rigueur et ma persévérance.

Je ne lâche jamais le morceau comme on dit.

Hélas, avec l'âge je ne retiens plus les choses comme avant.

D'où mes discussions, soit pour moi même ou pour aider (le plus souvent pour aider).

J'essaie d'aider avec ce qui reste dans ma caboche.

Je te remercie beaucoup. Ton fichier est avec tous les autres. J'espère retenir quelque chose de ce dernier.

Bonne journée.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
46
Affichages
2 K
Retour