OVH Cloud OVH Cloud

Problème de résolution

1 réponse
Avatar
José
Bonjour à tous,

Lorsque je porte une maacro qui gère plusieurs userforms sur un autre micro
que le mien, les userforms doublent de taille.
Y a-t-il une solution en VBA pour résoudre ce problème et ceci sans modifier
les paramètres d' affichage dans le panneau de configuration.

Merci

1 réponse

Avatar
fabienne HUÏEZ
-----Message d'origine-----
Bonjour à tous,

Lorsque je porte une maacro qui gère plusieurs userforms
sur un autre micro

que le mien, les userforms doublent de taille.
Y a-t-il une solution en VBA pour résoudre ce problème
et ceci sans modifier

les paramètres d' affichage dans le panneau de
configuration.


Merci

Utilise l'API "GetSystemMetrics" pour obtenir la
résolution de l'écran de ton utilisateur et adapter ainsi

la taille de tes userforms.
ci-joint un exemple

Public Declare Function GetSystemMetrics Lib "user32"
(ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1

Sub Bouton2_QuandClic()
Call AfficheBDD
End Sub

Sub AfficheBDD()
'formulaire BDDsaisie construit sur une résolution de
1024 x 768
Const largeur = 744
Const hauteur = 472
Select Case ScreenRes
Case Is = "640 x 480"
'62,5%
With BDDsaisie
.Zoom = 62
.Width = 0.625 * largeur
.Height = 0.625 * hauteur
End With


Case Is = "800 x 600"
'83,59%
With BDDsaisie
.Zoom = 83
.Width = 0.83 * largeur
.Height = 0.83 * hauteur
End With

Case Is = "856 x 480"
'78,125%
With BDDsaisie
.Zoom = 78
.Width = 0.78 * largeur
.Height = 0.78 * hauteur
End With

Case Is = "1024 x 768"
With BDDsaisie
.Zoom = 100
.Width = 1 * largeur
.Height = 1 * hauteur
End With


Case Is = "1152 x 864"
'112,5%
With BDDsaisie
.Zoom = 112
.Width = 1.12 * largeur
.Height = 1.12 * hauteur
End With

Case Is = "1280 x 720"
'125%
With BDDsaisie
.Zoom = 125
.Width = 1.25 * largeur
.Height = 1.25 * hauteur
End With

Case Is = "1280 x 1024"
'125%
With BDDsaisie
.Zoom = 125
.Width = 1.25 * largeur
.Height = 1.25 * hauteur
End With
End Select
resolution = MsgBox("Votre résolution d'écran est de " &
ScreenRes & "pixels", vbInformation)
BDDsaisie.Show
End Sub

Function ScreenRes()
Dim H As Integer, L As Integer
Application.Volatile
L = GetSystemMetrics(0)
H = GetSystemMetrics(1)
ScreenRes = L & " x " & H
'Debug.Print ScreenRes
End Function

fabienne.