[VBA]Taille UserForm sous Excel [Résolu]

Bonjour,

C'est tout à fait normal qu' une partie se retrouve en dehors de l'écran.
En effet, il faut repplacer tous ce qui se trouve sur l'UserForm, je l'avais oublié.

Dans l'initialisation du UserForm remplace tout par ceci.

Private Sub UserForm_Initialize()
'Déclaration des variables RX et RH
Dim RW As Single, RH 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
End Sub

J'espère que ça répondra à ton attente.

Didier

Bonjour,

Voilà à quoi ça peut ressembler en tenant compte du post #3 de Didier09 :

Dim lar As Long, lng As Long

Private Sub UserForm_Initialize()
Dim ctl As Control

'UserForm en plein écran
Me.Width = ScreenWidth * PointsPerPixel
Me.Height = ScreenHeight * PointsPerPixel


If (Me.WindowState = 1) Then Exit Sub

For Each ctl In Me.Controls
    If TypeOf ctl Is ComboBox Then
        ctl.Move ctl.Left * Me.Width / lng, ctl.Top * Me.Height / lar, ctl.Width * Me.Width / lng
    Else
        If ExistProperty(ctl, "Width") And ExistProperty(ctl, "Height") Then
            ctl.Move ctl.Left * Me.Width / lng, ctl.Top * Me.Height / lar, _
               ctl.Width * Me.Width / lng, ctl.Height * Me.Height / lar
        End If
    End If
Next

lng = Me.Width
lar = Me.Height


End Sub

'Verifie si une propriété existe pour le controle.
Public Function ExistProperty(Obj As Object, ByVal PropertyName As String) As Boolean
    On Error Resume Next
    CallByName Obj, PropertyName, VbGet
    ExistProperty = (Err.Number = 0)
    Err.Clear
End Function

;o)

Bonjour

Tout d'abord merci pour ce poste bien intérressant
avec mes petites connaissances excel, je suis arrivé à utiliser ce dernier code, et il fonction très bien pour la taille du userform, cepandant, j'ai à l'interieur de mes userforms, beaucoup de textbox ou commandbutton, et ceux-ci se chevauchent quand j'utilise mon fichier excel sur un PC qui possède un écran plus petit. Comment puis-je faire pour que chaque textbox, commandbutton, label... sois eux aussi proportionnelle à la taille de l'écran de l'ordi utilisé?

merci par avance a ceux qui pouront m'aider

tout d'abord, merci pour cette réponse rapide

après essaie, je bloque sur l'initialisation de mon premier userform, qui ne se fai pas, le VBA plante et souvre avec une messagebox qui me dit: "erreur de compilation, membre de méthode ou de donné introuvable"

blocage a la ligne suivante, avec surlignage sur .windowState
If (Me.WindowState = 1) Then Exit Sub

j'ai copier votre code sur la page code de mon premier userform, j'ai pensé que c'était l'endroi approprier... mais je me trompe peu être, sinon mon erreur est ailleur et j'ai du mal a voir où...
si vous pouvez encore m'éclairé... merci d'avance

Gawa

bonsoir,

Exact, il faut supprimer cette ligne qui fonctionne en VB6 mais pas avec VBA.

Désolé
Bonne continuation

;o)

lol ne me dis pas désolé, tu m'hôte une bonne épine du pied...

effectivement sans cette ligne le code est passer complètement mais c'est de nouveau arrèté avec une message box qui cette fois me dit "division par zéro" et surligne ma ligne "UserForm.show" dans mon workbook.
J'ai pensé que ça pouvait être que involontairement j'aurai créé un boucle indéfini entre le workbook et mon userForm, enfin c'est peut etre une hypothèse stupide... j'ai l'impression qu'une fois ce blocage passer mon userform va se lancer... touhoujours hypothètique ... voir uthopique... lol

salut,

As-tu testé avec "screen" ?

;o)

Polux

Bonjour,

Oui, mais screen n'est pas reconnu sous VBA ...

Merci quand même

Bonjour,
Dans un module place le code suivant

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

'The width of the screen, in pixels
Public Function ScreenWidth() As Long
ScreenWidth = GetSystemMetrics(SM_CXSCREEN)
End Function

'The height of the screen, in pixels
Public Function ScreenHeight() As Long
ScreenHeight = GetSystemMetrics(SM_CYSCREEN)
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)
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hDC
End Function



Ensuite Sur l'initialisation du formulaire

Private Sub UserForm_Initialize()
'UserForm en plein écran
Me.Width = ScreenWidth * PointsPerPixel
Me.Height = ScreenHeight * PointsPerPixel
End Sub

Je viens de le tester,chez moi ça marche.

Bonne programmation

Bonsoir,

Merci beaucoup, je teste ça demain et je te tiens au courant.
Si ça marche tu m'enlèves une grosse épine ...

Bonjour,

Merci Didier pour ton aide, ça marche en partie ... sur des pc portables avec des écrans 14", ça ne fonctionne pas, j'ai toujours une partie de mon formulaire en dehors de l'écran ...

Ce qui fait que mon fichier n'est pas portable (lol) ...

Merci encore pour ta contribution.

bonjour Didier,

J'avais intégré le redimensionnement des controles dans l'UserForm ... le problème ne vient pas de là ... Je pense que cela vient du fait que j'ai fait cette petite appli sur Excel 2007, même en sauvegardant a un format antérieur. J'ai repris le fichier sur un autre ordi avec Excel 2003, et cette fois l'appli passe sans problème partout ... merci Microsoft pour les compatibilités ... Autre inconvénient, lors des tests en mode débogeur, si il y a une correction à faire. Il faut fermer Excel, le relancer, faire les modifs et sauvegarder ... je me suis aperçu que si l'on ne fait pas comme ça et que l'on arrête le débogeur avant la fin de l'excécution, les modifs ne sont pas prises en compte. Excel considère qu'il y a eu un plantage et restore la dernière version lors du lancement de l'appli ... c'est assez prise de tête ...

Merci encore pour ton aide.

Neverend