USERFORM / adaptation de résolution avec résolution d'origine 1600*900

GADENSEB

XLDnaute Impliqué
Hello Le forum,

j'ai créée mes usf :
- BASEEMPLOI
- GENERAL
- GESTIONPOSTE

sur mon pc avec une résolution de 1600*900

Comme je balade avec ce fichier sur différents pc, mes usf n’apparaissent pas correctement du fait du changement de résolution

Du coup, je me dis que l'idéal serait d'adapter les usf ( et son contenu: textbox....) à _initiaze en créant une variable de la résolution de l'écran d'ouverture

Du style :
REZO = résolution actuelle du poste
REZO = X% de la résolution d’origine

X% pouvant être en + ou - de 100%

--> Taille usf et son contenu redimensionné à X%

Pfiou !!!

Une idée farfelue par nuit ! :cool:

Bonne journée

seb
 

Pièces jointes

  • BASE EMPLOI - DEMO v1.xlsm
    264.9 KB · Affichages: 26
  • BASE EMPLOI - DEMO v1.xlsm
    264.9 KB · Affichages: 31
  • BASE EMPLOI - DEMO v1.xlsm
    264.9 KB · Affichages: 25

Dull

XLDnaute Barbatruc
Re : USERFORM / adaptation de résolution avec résolution d'origine 1600*900

Salut GADENSEB, LE Forum

il faut ajouter dans en tête de module de l'Usf
Code:
Option Explicit
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

Private Const GWL_STYLE As Long = (-16)         'The offset of a window's style
Private Const WS_MINIMIZEBOX = &H20000          'Style to add a Minimize box on the title bar
Private Const WS_CAPTION As Long = &HC00000     'Style to add a titlebar

Private Const SW_MAXIMIZE = 3                   'constantes pour la fonction
Private Const SW_MINIMIZE As Long = 6           'ShowWindow

Private hwnd As Long, Style As Long
Private wInit As Long, hInit As Long                'ses dimensions d'origine
Private FormInit As Boolean                         'définit l'étape d'initialisation de la form
ensuite
à l'activation de ce dernier
Code:
Private Sub UserForm_Activate()
    ShowWindow hwnd, SW_MAXIMIZE
End Sub

juste dessous Private Sub UserForm_Initialize()

Code:
Dim W As Double
Dim hMenu As Long

   hwnd = FindWindow(vbNullString, Me.Caption)
   Style = GetWindowLong(hwnd, -16) And Not &HC00000
   SetWindowLong hwnd, GWL_STYLE, Style
   DrawMenuBar hwnd
wInit = Me.Width: hInit = Me.Height 'By Hasco
FormInit = True
et enfin toujours dans le module de l'Usf
Code:
Private Sub UserForm_Resize()

    Dim RW As Single, RH As Single
    If FormInit = False Then Exit Sub       'on ne doit exécuter les redimensionnements des contrôles qu'une fois au départ!
    RW = Me.Width / wInit: RH = Me.Height / hInit
    'redimensionnement et replacement de l'ensemble des contrôles voulus en fonction de l'écran
    Dim Ctl As MSForms.Control
    For Each Ctl In Me.Controls
        'on a mis un tag pour les contrôles que l'on ne veut pas redimensionner
        'If Ctl.Tag = "" Then
        Ctl.Move Ctl.Left * RW, Ctl.Top * RH, Ctl.Width * RW, Ctl.Height * RH
        If Not TypeOf Ctl Is Image Then     'ajouter si besoin les autres contrôles n'ayant pas de police
            Ctl.Font.Size = Round(Ctl.Font.Size * RH)   'redim des polices
        End If
    Next
    FormInit = False

End Sub

l'UserForm prendra la dimension de l'écran quelque soit la taille de celui-ci

je n'ai fait que pour ton Usf BASEEMPLOI

Bonne Journée
 

Pièces jointes

  • BASE EMPLOI - DEMO v1.xlsm
    269.6 KB · Affichages: 45
  • BASE EMPLOI - DEMO v1.xlsm
    269.6 KB · Affichages: 48
  • BASE EMPLOI - DEMO v1.xlsm
    269.6 KB · Affichages: 52

GADENSEB

XLDnaute Impliqué
Re : USERFORM / adaptation de résolution avec résolution d'origine 1600*900

Pfiou !!!

Déjà merci pour le travail de fou !

Par contre je vais affiner mon texte, je me suis peut être mal exprimé

Disons que mon usf BASEEMPLOI représente 4/5 (en portrait) de la résolution 1600*900, je voudrais que cette proportion reste suivant la dimension de l'écran sur lequel je suis ....

Pas que l'usf prenne tt l'écran !

Du coup est-ce plus clair comme ça ?
 

Statistiques des forums

Discussions
312 198
Messages
2 086 122
Membres
103 126
dernier inscrit
Vuagno27