IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Maximiser un userform à l'initialisation [XL-2013]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre du Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Mars 2014
    Messages
    5
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 44
    Localisation : Maroc

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Mars 2014
    Messages : 5
    Par défaut Maximiser un userform à l'initialisation
    j'ai déjà déclaré les fonctions API et une fonction "InitMaxMin" dans un module standard, aussi j'ai définie la fonction resize et fini de mon userform
    les petites icones de réduction et d'agrandissement marchent très bien, bref Max Min Resize fonctionnent bien.
    je voulais seulement maximiser mon userfom à l'initialisation

    dans un module standard ( mon code ):
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    Option Explicit
     
    ' declaration API pour réduire, agrandir,resize
    Public Declare Function FindWindowA& Lib "user32" (ByVal lpClassName$, ByVal lpWindowName$)
    Public Declare Function GetWindowLongA& Lib "user32" (ByVal hwnd&, ByVal nIndex&)
    Public Declare Function SetWindowLongA& Lib "user32" (ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&)
     
    ' Déclaration des constantes
    Public Const GWL_STYLE As Long = -16
    Public Const WS_MINIMIZEBOX = &H20000
    Public Const WS_MAXIMIZEBOX = &H10000
    Public Const WS_FULLSIZING = &H70000
     
    'Attention, envoyer après changement du caption de l'UF
    Public Sub InitMaxMin(mCaption As String, Optional Max As Boolean = True, Optional Min As Boolean = True _
            , Optional Sizing As Boolean = True)
    Dim hwnd As Long
        hwnd = FindWindowA(vbNullString, mCaption)
        If Min Then SetWindowLongA hwnd, GWL_STYLE, GetWindowLongA(hwnd, GWL_STYLE) Or WS_MINIMIZEBOX
        If Max Then SetWindowLongA hwnd, GWL_STYLE, GetWindowLongA(hwnd, GWL_STYLE) Or WS_MAXIMIZEBOX
        If Sizing Then SetWindowLongA hwnd, GWL_STYLE, GetWindowLongA(hwnd, GWL_STYLE) Or WS_FULLSIZING
    End Sub
     
    'Application.DisplayFullScreen = True

  2. #2
    Membre expérimenté Avatar de arosec
    Homme Profil pro
    Chef de projet en SSII
    Inscrit en
    Mai 2009
    Messages
    167
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Marne (Champagne Ardenne)

    Informations professionnelles :
    Activité : Chef de projet en SSII
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Mai 2009
    Messages : 167
    Par défaut
    Bonsoir,

    Peut être pas parfait mais très court!

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
     
    Private Sub UserForm_Initialize()
        Application.WindowState = xlMaximized
        Me.Height = Application.Height
        Me.Width = Application.Width
    End Sub

  3. #3
    Membre du Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Mars 2014
    Messages
    5
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 44
    Localisation : Maroc

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Mars 2014
    Messages : 5
    Par défaut maximiser un userform à l'initialisation
    @arosec

    ça marche pas, parce que dans userform-resize() j'ai déclaré des variables qui sont fonction de Me.Height et Me.Width, donc j'avais un débogage dans ces deux lignes.

    voici mon code:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    Private Sub UserForm_Resize()
    Dim RtL As Single, RtH As Single
        If Me.Width < 300 Or Me.Height < 200 Or Fini Then Exit Sub
        RtL = Me.Width / Lg
        RtH = Me.Height / Ht
        Me.Zoom = IIf(RtL < RtH, RtL, RtH) * 100
     
    End Sub

  4. #4
    Inactif  

    Homme Profil pro
    cuisiniste
    Inscrit en
    Avril 2009
    Messages
    15 374
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : Avril 2009
    Messages : 15 374
    Billets dans le blog
    8
    Par défaut heu
    Bonjour

    mais non! il y a les apis pour ca

    si tu avais fait une recherche dans les contributions et même dans ce forum tu aurais trouvé tres facilement

    c'est un sujet assez récurent


    version 32 bits
    colle ca dans un module standard
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
     
     Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
       Public Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
       Public Declare Function SWLg Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Public HANDLE
    Public old_largeur
    Public old_hauteur
    Function trois_boutons(uf As Object)    'on va ajouter les deux boutons manquants et l'élasticité a l'userform
    '*****************************************************************
    '*ici on memorise les dimention de depart de l'userform          *
        old_largeur = uf.InsideWidth: old_hauteur = uf.InsideHeight    '*
    '*****************************************************************
    '***************************************************************************************************************
    ' ici on determine le handle                                                                                   *
        HANDLE = FindWindow(vbNullString, uf.Caption)    '                                                         *
    ' ici on applique les changement (&H84CF0080= les trois bouton et l'elasticité)                                *
        SWLg HANDLE, -16, &H84CF0080                                                                              '*
    '***************************************************************************************************************
    '***********************************************************************************************************************************************************
    'on memorise a l'interieur du tag du control ses propriétés ainsi que son son font size                                                                   '*
        For Each ctrl In uf.Controls                                                                                                                          '*
            ctrl.Tag = ctrl.Left & ";" & ctrl.Top & ";" & ctrl.Width & ";" & ctrl.Height                                                                      '*
            If TypeName(ctrl) <> "SpinButton" And TypeName(ctrl) <> "Image" And TypeName(ctrl) <> "ScrollBar" Then ctrl.Tag = ctrl.Tag & ";" & ctrl.Font.Size '*
        Next                                                                                                                                                  '*
    '***********************************************************************************************************************************************************
    End Function
    Function plein_ecran()
    ' on affiche le userform en plein ecran avec l'api showwindowa de la user32.dll  bien moins lourd que mes versions precedente de maximisation de l'userform et plus rapide et plus propre
    '1= mode normal:3 =maximiser:6 =minimiser
    'le handle du userform a été declaré en public au debut du module et  identifié dans la routine des trois boutons il n'est donc plus necessaire de l'identifier
    ShowWindow HANDLE, 3
    End Function
     
    Function maForm_Resize(usf As UserForm)
    'ici on determine le multiplicateur qui differenci la dimention de base a celle actuelle de l'userform
        newlargeur = usf.InsideWidth / old_largeur: newhauteur = usf.InsideHeight / old_hauteur
        'ici on boucle sur tout les controls
        For Each Ctl In usf.Controls
            ppe = Split(Ctl.Tag, ";")    'on coupe le tag par les ";"
            'et on applique le multiplicateur au controls pour la largeur et la hauteur en une seule ligne
            Ctl.Move ppe(0) * newlargeur, ppe(1) * newhauteur, ppe(2) * newlargeur, ppe(3) * newhauteur
            'l'element(4) de ppe contient le font size du controls
            If UBound(ppe) = 4 Then Ctl.Font.Size = ppe(4) * newlargeur
        Next
    End Function
    et ca dans le module du userform
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    Private Sub UserForm_Activate()
     
    trois_boutons Me 'on ajoute les 2 boutons de la captions qui manque 'FACULTATIF
    plein_ecran 'on met en plein écran des le départ
    End Sub
    Private Sub UserForm_Resize()
    maForm_Resize Me 'on va redimensionner les contrôles proportionnellement
    End Sub
    teste ca tu m'en diras des nouvelles
    si tu travaille en 64 bits il te faudra modifier la déclaration des 3 apis en 64 bits
    dis moi si tu n'y arrive pas et ou est l'erreur si il y a

    Au plaisir
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  5. #5
    Membre du Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Mars 2014
    Messages
    5
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 44
    Localisation : Maroc

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Mars 2014
    Messages : 5
    Par défaut résolu
    @ patricktoulon
    votre suggestion fonctionne très bien.
    Merci

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Variable type UserForm à initialiser avec nom variable
    Par dalmasma dans le forum Général VBA
    Réponses: 2
    Dernier message: 28/04/2009, 14h03
  2. Problème initialisation UserForm
    Par pipo159 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 16/10/2008, 23h57
  3. initialisation d'une userform
    Par Manu18 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 01/04/2008, 17h51
  4. initialisation textbox dans userform
    Par oscar.cesar dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 11/08/2007, 09h24
  5. Réponses: 10
    Dernier message: 27/05/2007, 20h24

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo