[VBA]Taille UserForm sous Excel

Résolu
Bonjour,

J'ai créé sous Excel, un formalaire de saisie (UserForm).

Pour avoir la taille maxi de l'écran j'ai codé comme cela :

With UserForm1

        .StartUpPosition = 3
        .Width = Application.Width
        .Height = Application.Height
        .Left = 0
        .Top = 0
End With


Je rencontre un problème d'affichage lorsque mon fichier est ouvert sur certain PC portables (écran 15" notamment) où mon formulaire est plus grand que l'écran.

Si quelqu'un avait une solution pour que quelque soit l'écran et la définition de l'écran mon formulaire soit à la bonne taille, je lui en serais reconnaissant ...

Merci

neverend
Configuration: Windows XP
Internet Explorer 6.0

12 réponses

  1. 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)
    2
    1. 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
      2
      1. 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
        1
        1. salut,

          As-tu testé avec "screen" ?

          ;o)

          Polux
          0
          1. 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
            0
            1. bonsoir,

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

              Désolé
              Bonne continuation

              ;o)
              0
              1. 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
                0
                1. Bonjour,

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

                  Merci quand même
                  -1
                  1. 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
                    -1
                    1. Bonjour,
                      Je me permet de vous interpeller car je suis débutant en Vba excel 2003 et j'ai repris votre source pour redimentionner l'écran, mais depuis la date systeme ne s'affiche plus dans un label et dans un textbox à l'ouverture de l' Userform, pourriez vous m'aider svp.
                      merci pour votre source.
                      fadan
                      Voici ma source:

                      Private Sub FRM_journalier_Initialize()
                      ' votre source que j'ai repris et qui fonctionne très bien
                      Next
                      Dim madate As Date
                      madate = Format(Now(), "dddd dd mmmm yyyy") ' Déclaration du format de la dateSysteme
                      Lbl_dateSysteme = UCase(Left(madate, 1)) & Right(madate, Len(madate) - 1) ' Majuscule sur le nom du jour
                      Txt_dateDebut.Value = Format(Now(), "dd/mm/yyyy") ' Affichage de la date systeme dans le txt_dateDebut
                      Txt_heureDebut.Value = Format(Now(), "HH:mm") ' Affichage de l'heure systeme dans le textbox
                      End Sub
                      0
                  2. Bonsoir,

                    Merci beaucoup, je teste ça demain et je te tiens au courant.
                    Si ça marche tu m'enlèves une grosse épine ...
                    -1
                    1. 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.
                      -1
                      1. 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
                        -1