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.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
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.
-----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
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