Bonjour à tous j’ai créé une interface pour mon boulot sur mon pc sa fonctionne très bien mais je suis amené à donner ma programmation à plusieurs personnes de l’entreprise mais ces personnes n’on pas forcément la même résolution d’écran. Je dois donc adapter ma form en fonction de celui-ci
J’ai un début de programme qui marche mais mon pb c’est que je n’arrive pas à repositionner mes contrôles (ex : commandbutton1.top reste à la meme place) sa ne fonctionne pas
Si quelqu’un a compris et peut m’aide
Merci d’avance
Private Sub UserForm_Initialize()
'UserForm en plein écran
Me.Width = ScreenWidth * PointsPerPixel
Me.Height = ScreenHeight * PointsPerPixel
'Déclaration des variables RX et RH
Dim RW As Single, RH As Single 'RMW As Single, RMH As Single
'Calcule le rapport de l'UserForm et la taille de l'écran
RW = ScreenWidth * PointsPerPixel / Me.Width
RH = ScreenHeight * PointsPerPixel / Me.Height
'Met l'UserForm en plein écran
Me.Width = ScreenWidth * PointsPerPixel
Me.Height = ScreenHeight * PointsPerPixel
'Déclaration de la variable Ctl qui correspond aux contrôles de ton UserForm
Dim Ctl As MSForms.Control
'Permet de redimensionner tous tes contrôles présent sur l'UserForm en fonction de la taille de l'userForm et de la taille de l'écran
For Each Ctl In Me.Controls
Ctl.Move Ctl.Left * RW, Ctl.Top * RH, Ctl.Width * RW, Ctl.Height * RH
Next
‘Suite programme…
End Sub
Dans un module
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0 'Screen width
Private Const SM_CYSCREEN = 1 'Screen height
Private Declare Function GetDC Lib "user32" _
(ByVal hWnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Const LOGPIXELSX = 88 'Pixels/inch in X
'A point is defined as 1/72 inches
Private Const POINTS_PER_INCH As Long = 72
'la largeur de l'ecran, en pixels
Public Function ScreenWidth() As Long
ScreenWidth = GetSystemMetrics(SM_CXSCREEN)
Debug.Print ScreenWidth
End Function
'la hauteur de l'ecran, en pixels
Public Function ScreenHeight() As Long
ScreenHeight = GetSystemMetrics(SM_CYSCREEN)
Debug.Print ScreenHeight
End Function
'The size of a pixel, in points
Public Function PointsPerPixel() As Double
Dim hDC As Long
Dim lDotsPerInch As Long
hDC = GetDC(0)
Debug.Print hDC
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
Debug.Print lDotsPerInch
Debug.Print POINTS_PER_INCH
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
Debug.Print PointsPerPixel
ReleaseDC 0, hDC
End Function