Affichage Userform en plein écran quelque soit la taille de l'écran

youguybass

XLDnaute Junior
Bonjour tt le monde
Je cherche à ouvrir un userform en plein écran quelque soit la taille de l'écran, naturellement c'est un fichier partagé !
Sur mon poste aucun soucis mais sur des écrans + petit cela ne marche pas.

J'ai comme code:
Option Explicit
Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

et

Private Sub UserForm_Initialize()
Dim hwnd As Long, exLong As Long, zFactor As Integer

hwnd = FindWindowA(vbNullString, Me.Caption)
exLong = GetWindowLongA(hwnd, -16)
If exLong And &H880000 Then SetWindowLongA hwnd, -16, exLong And &HFF77FFFF
zFactor = 100 * CInt(Application.Width / Me.Width)
Me.Width = Application.Width
Me.Height = Application.Height

End Sub

est-ce que quelqu'un aurait une solution ?

D'avance merci
 

halecs93

XLDnaute Impliqué
Bonjour tt le monde
Je cherche à ouvrir un userform en plein écran quelque soit la taille de l'écran, naturellement c'est un fichier partagé !
Sur mon poste aucun soucis mais sur des écrans + petit cela ne marche pas.

J'ai comme code:
Option Explicit
Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

et

Private Sub UserForm_Initialize()
Dim hwnd As Long, exLong As Long, zFactor As Integer

hwnd = FindWindowA(vbNullString, Me.Caption)
exLong = GetWindowLongA(hwnd, -16)
If exLong And &H880000 Then SetWindowLongA hwnd, -16, exLong And &HFF77FFFF
zFactor = 100 * CInt(Application.Width / Me.Width)
Me.Width = Application.Width
Me.Height = Application.Height

End Sub

est-ce que quelqu'un aurait une solution ?

D'avance merci
Peut-être ceci
VB:
Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Sub UserForm_Initialize()
    Dim hwnd As Long, exLong As Long
    Dim screenWidth As Long, screenHeight As Long
    
    ' Récupérer le handle de la fenêtre UserForm
    hwnd = FindWindowA(vbNullString, Me.Caption)
    
    ' Récupérer le style de la fenêtre
    exLong = GetWindowLongA(hwnd, -16)
    
    ' Si un certain style est activé, le désactiver
    If exLong And &H880000 Then SetWindowLongA hwnd, -16, exLong And &HFF77FFFF
    
    ' Obtenir la résolution de l'écran en utilisant GetSystemMetrics
    screenWidth = GetSystemMetrics(0)  ' SM_CXSCREEN (largeur de l'écran)
    screenHeight = GetSystemMetrics(1) ' SM_CYSCREEN (hauteur de l'écran)
    
    ' Redimensionner le formulaire à la taille de l'écran
    Me.Width = screenWidth
    Me.Height = screenHeight
End Sub
 

youguybass

XLDnaute Junior
Peut-être ceci
VB:
Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Sub UserForm_Initialize()
    Dim hwnd As Long, exLong As Long
    Dim screenWidth As Long, screenHeight As Long
   
    ' Récupérer le handle de la fenêtre UserForm
    hwnd = FindWindowA(vbNullString, Me.Caption)
   
    ' Récupérer le style de la fenêtre
    exLong = GetWindowLongA(hwnd, -16)
   
    ' Si un certain style est activé, le désactiver
    If exLong And &H880000 Then SetWindowLongA hwnd, -16, exLong And &HFF77FFFF
   
    ' Obtenir la résolution de l'écran en utilisant GetSystemMetrics
    screenWidth = GetSystemMetrics(0)  ' SM_CXSCREEN (largeur de l'écran)
    screenHeight = GetSystemMetrics(1) ' SM_CYSCREEN (hauteur de l'écran)
   
    ' Redimensionner le formulaire à la taille de l'écran
    Me.Width = screenWidth
    Me.Height = screenHeight
End Sub
Merci bien mais ...
Ce code fonctionne sur mon poste mais Je viens de tester sur le portable de mon patron et cela ne fonctionne pas, l'ajustage ne se fait pas
 

jurassic pork

XLDnaute Occasionnel
Hello,
le code de Dranreb dépend de la taille de l'application dans laquelle est lancé le formulaire. Il faut maximiser l'application dans l'initialisation du formulaire.
Voici un code qui le fait avec en plus un retour à la taille initiale de l'application après le réglage de la taille du formulaire.
VB:
Private Sub UserForm_Initialize()
Dim xlws As XlWindowState
xlws = Application.WindowState
Application.WindowState = xlMaximized
With Me
    .Top = Application.Top
    .Left = Application.Left
    .Width = Application.Width
    .Height = Application.Height
End With
Application.WindowState = xlws
End Sub

Ami calmant, J.P
 
Dernière édition:

youguybass

XLDnaute Junior
Bonjour et merci mais mon code (PJ) fonctionne mieux sur mon poste .
Je ne veux pas que l'on ait accès à la croix de fermeture.
Avec le code de Jurassik, le bas du userform n'apparait pas completement.

VB:
Dim hWnd As Long, exLong As Long, zFactor As Integer

  hWnd = FindWindowA(vbNullString, Me.Caption)
  exLong = GetWindowLongA(hWnd, -16)
  If exLong And &H880000 Then SetWindowLongA hWnd, -16, exLong And &HFF77FFFF
  zFactor = 100 * CInt(Application.Width / Me.Width)
  Me.Width = Application.Width
  Me.Height = Application.Height

Ouverture avec mon code sur mon poste
Mon Code.png

Code de Jurrasik sur mon poste
Code de Jurassik.png

ouverture sur écran 15" avec mon code et résultat similaire avec code de Jurassik
Ouverture sur écran 15 pouces.png
 

jurassic pork

XLDnaute Occasionnel
C'est sûr que si ton formulaire a une taille originale supérieure à la résolution de l'écran sur lequel tu l'affiches , tu ne le verras pas complétement. les contrôles à l'intérieur du formulaire ne se redimensionnent pas. Il me semble que patricktoulon a déjà fait ce genre de manipulation [EDIT] voir ici ou alors il faut mettre des barres de défilement.
 
Dernière édition:

youguybass

XLDnaute Junior
Je n'y arrive pas !!!!!!!!!!
J'ai essayé votre code PatrickToulon mais l'ajustement ne se fait pas.:rolleyes:
VB:
 Dim hwnd&
hwnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")")    'api GetActiveWindow Capture du handle de la fenetre active
ExecuteExcel4Macro ("CALL(""user32"",""ShowWindow"",""JJJ"",""" & hwnd & """,""" & 3 & """)")    ' application du mode
    ' et si tu veux les trois bouton debloque la ligne ci dessous
    'ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & hwnd & ", " & -16 & ", " & &H94CF0080 & ")")     'api SetWindowLongA
    On Error Resume Next
    coeffzoom = Application.Min(Me.Height / HautUF, Me.Width / LargUF)
    Me.Zoom = 100 * coeffzoom
Je vous joints le fichier,
Normalement en cliquant sur "dossier de réalisation" Le user s'ouvre plein écran c'est bon sur mon 24" mais pas sur le 17"

Slts
 

Pièces jointes

  • Base de données Outillages vide.xlsm
    114.9 KB · Affichages: 7

Discussions similaires

Statistiques des forums

Discussions
314 121
Messages
2 106 128
Membres
109 495
dernier inscrit
jerome bonneau