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

youguybass · Lundi à 08:25

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

patricktoulon · Jeudi à 20:48

Bonsoir

il est ou mon module resize hein!!!
bon allez je te met ça
c'est tout TOTOMATIC

halecs93 · Lundi à 08:31

youguybass à dit:
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 · Lundi à 10:01

halecs93 à dit:

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

Dranreb · Lundi à 10:37

bonjour.
Si je mets ça dans un UserForm, il s'ajuste lors du .Show :

VB:

Private Sub UserForm_Activate()
   Me.Left = Application.Left
   Me.Width = Application.Width
   Me.Top = Application.Top
   Me.Height = Application.Height
   End Sub

youguybass · Lundi à 22:51

Ça coince toujours
Pour le moment j'ai ajouté des boutons zoom + et zoom - sur le userform afin de le faire varier en fonction de l'écran

TooFatBoy · Lundi à 23:50

Bonjour,

Juste par curiosité, c'est pour quelle application ?

youguybass · Mardi à 06:53

Bonjour
C'est un fichier Excel avec Vba pour la gestion de mon service.
Slts

jurassic pork · Mardi à 07:10

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

youguybass · Mardi à 08:53

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

Code de Jurrasik sur mon poste

ouverture sur écran 15" avec mon code et résultat similaire avec code de Jurassik

jurassic pork · Mardi à 09:41

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.

patricktoulon · Jeudi à 05:02

Bonjour
si tu cherche bien tu trouvera mon module resize pour userform qui te permet d'afficher ton userform en plein écran quelque soit l’écran sans perdre un control
et cela que le userform (à la base)soit plus grand ou plus petit que l’écran

youguybass · Jeudi à 06:30

Je pense que le zoom auto de Patrick Toulon devrait m'alerter.
Je testerai dans la journée.
Slts

youguybass · Jeudi à 08:20

Je n'y arrive pas !!!!!!!!!!
J'ai essayé votre code PatrickToulon mais l'ajustement ne se fait pas.

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

jurassic pork · Jeudi à 16:25

Hello,
et en utilisant des barres de défilement ?

Ami calmant, J.P

patricktoulon · Jeudi à 20:48

Bonsoir

il est ou mon module resize hein!!!
bon allez je te met ça
c'est tout TOTOMATIC

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

youguybass

XLDnaute Junior

patricktoulon

halecs93

XLDnaute Impliqué

youguybass

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

youguybass

XLDnaute Junior

TooFatBoy

XLDnaute Barbatruc

youguybass

XLDnaute Junior

jurassic pork

XLDnaute Occasionnel

youguybass

XLDnaute Junior

jurassic pork

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

youguybass

XLDnaute Junior

youguybass

XLDnaute Junior

Pièces jointes

jurassic pork

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Discussions similaires