[VBA]Taille UserForm sous Excel

Résolu
Neverend Messages postés 21 Statut Membre -  
 gawanabana chico -
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. Polux31 Messages postés 7219 Statut Membre 1 204
     
    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
  2. gawanabana chico
     
    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
  3. didier09 Messages postés 13 Statut Membre 36
     
    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
  4. Polux31 Messages postés 7219 Statut Membre 1 204
     
    salut,

    As-tu testé avec "screen" ?

    ;o)

    Polux
    0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. gawanabana chico
     
    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
  7. Polux31 Messages postés 7219 Statut Membre 1 204
     
    bonsoir,

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

    Désolé
    Bonne continuation

    ;o)
    0
  8. gawanabana chico
     
    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
  9. Neverend Messages postés 21 Statut Membre 81
     
    Bonjour,

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

    Merci quand même
    -1
  10. didier09 Messages postés 13 Statut Membre 36
     
    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. fadan
       
      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
  11. Neverend Messages postés 21 Statut Membre 81
     
    Bonsoir,

    Merci beaucoup, je teste ça demain et je te tiens au courant.
    Si ça marche tu m'enlèves une grosse épine ...
    -1
  12. Neverend Messages postés 21 Statut Membre 81
     
    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
  13. Neverend Messages postés 21 Statut Membre 81
     
    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