Adapter un USF à la taille de l'écran

Bonjour,

Je voudrais que mon USF s'ajuste automatiquement à la taille de l'écran pour pouvoir aussi bien l'ouvrir sur un PC de bureau que sur une tablette.

Pour le moment j'ai trouvé ce code mais qui va ajuster seulement le cadre mais les TextBox et autres champs du formulaire ne s'ajustent pas, j'ai pu lire sur certain forum qu'il fallait se servir du Zoom mais je n'y arrive pas

Je vous mets déjà le bout de code que j'ai trouvé

    'Adapte le Userform automatiquement à la taille de l'écran
With Me
.StartUpPosition = 3
.Width = Application.Width
.Height = Application.Height
.Left = 0
.Top = 0
'End With

Merci par avance

Franck

Bonjour,

En fait il te faut calculer le rapport entre la taille de ton userform et celle de l'application :

Private Sub UserForm_Initialize()

    Dim Rx As Single
    Dim Ry As Single

    'Userform
    With Me

        Rx = Application.Width / .Width
        Ry = Application.Height / .Height

        .StartUpPosition = 1
        .Left = 0
        .Top = 0
        .Height = Application.Height
        .Width = Application.Width

    End With

    'TextBox
    With TextBox1

        .Width = .Width * Rx
        .Height = .Height * Ry
        .Left = .Left * Rx
        .Top = .Top * Ry

    End With

    'Bouton
    With CommandButton1

        .Width = .Width * Rx
        .Height = .Height * Ry
        .Left = .Left * Rx
        .Top = .Top * Ry

    End With

    Me.Show

End Sub

Hervé.

Bonjour Theze,

Je te remercie déjà

Je viens d'essayer avec le code que tu m'as donné mais je n'y arrive pas.

Je te mets en fichiers joint le classeur excel

Je voudrais le faire sur toutes les feuilles du USF

Du coup Je t'ai mis le fichier avant que je le modifie

Voila en espérant que tu pourras m'aider.

Bonjour,

Voilà le code avec la partie à rajouter (voir commentaire en majuscule) dans la procédure évènementielle "Initialize". Adapte pour les autres Forms :

Private Sub userForm_Initialize()

    Dim Rx As Single
    Dim Ry As Single
    Dim Cell As Range
    Dim Tableau()
    Dim TempTab As Variant
    Dim i As Integer, j As Integer
    Dim boolVerif As Boolean

    ReDim Tableau(1 To 1)
    Tableau(1) = Cells(1, 1)

    'Boucle sur les données de la colonne A, dans la Feuil1
    For Each Cell In Worksheets("Basedonnees").Range("A1:A" & _
                        Worksheets("Basedonnees").Range("A65536").End(xlUp).Row)
        boolVerif = False

        'Vérifie si le contenu de la cellule existe déjà dans le tableau
        For i = 1 To UBound(Tableau)
            'Si la donnée existe déjà dans le tableau
            If Tableau(i) = Cell Then
                boolVerif = True
                Exit For
            End If
        Next i

        'Si la donnée n'existe pas dans le tableau, on augmente la taille du tableau
        'et on ajoute la donnée.
        If Cell <> "" Then
        If boolVerif = False Then
            ReDim Preserve Tableau(1 To UBound(Tableau) + 1)
            Tableau(UBound(Tableau)) = Cell
        End If
        End If

        'Tri le contenu du tableau par ordre croissant.
        For i = 1 To UBound(Tableau)
            For j = 1 To UBound(Tableau)
                If Tableau(i) < Tableau(j) Then
                    TempTab = Tableau(i)
                    Tableau(i) = Tableau(j)
                    Tableau(j) = TempTab
                End If
            Next j
        Next i
    Next Cell

    'Alimente le ComboBox
    ListLicence.List = Tableau

    '_____________________________________________________________________
    '_____________________________________________________________________
    'ICI LA PARTIE RAJOUTEE QUI DOIT PRENDRE EN COMPTE CHAQUE CONTROLE :
    With Me

        Rx = Application.Width / .Width
        Ry = Application.Height / .Height

        .StartUpPosition = 1
        .Left = 0
        .Top = 0
        .Height = Application.Height
        .Width = Application.Width

    End With

    'Bouton
    With CmdLicencie

         .Width = .Width * Rx
         .Height = .Height * Ry
         .Left = .Left * Rx
         .Top = .Top * Ry

    End With

    'Liste
    With CdrLicence

         .Width = .Width * Rx
         .Height = .Height * Ry
         .Left = .Left * Rx
         .Top = .Top * Ry

    End With

    'Titre 1
    With Label1

         .Width = .Width * Rx
         .Height = .Height * Ry
         .Left = .Left * Rx
         .Top = .Top * Ry

    End With

    'Titre 2
    With Label2

         .Width = .Width * Rx
         .Height = .Height * Ry
         .Left = .Left * Rx
         .Top = .Top * Ry

    End With

End Sub

Hervé.

Bonjour Hervé,

Parfait tout fonctionne correctement

Merci pour ton aide