XL 2016 redimensionner un userform avec la souris

[Fabien35200]

Bonjour à tous,

je cherche à pouvoir redimensionner un userform avec la souris comme toute fenetre sur windows.J ai testé ce code parmis bcp d autre mais aucun effet:

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then
        If X > Me.Width - 10 And Y > Me.Height - 10 Then
            Me.Width = X
            Me.Height = Y
        End If
    End If
End Sub

merci par avance pour votre aide.

Cordialement.

Fabien.

 

[GALOUGALOU]

bonjour fabien35200 bonjour le forum
un lien avec une solution

Resize userform

Resize userform without APIs

www.andypope.info

cordialement
galougalou

 

[Fabien35200]

Bonjour Galougalou,

merci pour ton retour,mais je souhaiterai que les éléments qui se situent dans l userform puisse s adapter à la nouvelle échelle du rétrécissement ou de l agrandissement.En effet ,lorsqu on modifie la taille de la fenêtre sur ton fichier ,les case peuvent être cacher par la suite.
Aurais tu une idée pour cela?
Merci par avance.

 

[VIARD]

Bonjour Galougalou, Fabien et à tous

Une autre solution sans API, de Maître TI.
Je l'adapte suivant mes besoins, très pratique quand on utilise une tablette.
voici le code:

Option Explicit

'Thierry'démo pour ajustement USF, January 2004

Const Largeur As Long = 367
Const Hauteur As Long = 400
Dim Coef As Long
Dim ActionSpin As String
Dim ActionList As String
---------------------------
Private Sub UserForm_initialize()
With Me.SpinButton1
.Value = 100
.Min = 50
.Max = 200
End With
Reglage
End Sub
----------------------
Private Sub SpinButton1_SpinUp()
ActionSpin = "Plus"
Reglage
End Sub
-------------------------------
Private Sub SpinButton1_SpinDown()
ActionSpin = "Moins"
Reglage
End Sub
--------------------------------
Private Sub Reglage()
With Me
Coef = .SpinButton1 - 100
.Height = ((Hauteur / 100) * Coef) + Hauteur
.Width = ((Largeur / 100) * Coef) + Largeur
.Zoom = .SpinButton1
End With
End Sub

A+ Jean-Paul

 

[Fabien35200]

bonjour Jean Paul,merci pour ta contribution.Effectivement il fait le job ,mais l ideal serait d avoir ton code et celui de Galougalou en 1 pour n avoir que la souris dans l angle qui gère.

 

[patricktoulon]

bonjour
redimensionner l'userform avec la souris sans api Windows en voila une belle histoire
allez Kado (par les 4 angle et coté a l’intérieur )

'*********************************************************************************
'                       Collection UserForm Patricktoulon                        *
'                USERFORM REDIMENTIONABLE AVEC LA SOURIS SANS API                *
'                                                                                *
'Auteur:patricktoulon sur Exceldownload                                          *
'version 2.0 sans controls label pilote                                          *
'date version :24/03/2020                                                        *
'l'userform est redimmentionnable par les 4 cotés et les 4 angles                *
'le mouse pointeur vous indique le sens et le type de redimmentionnement         *
'une contante booleenne au depart pour decider si il est resizable ou pas        *
'*********************************************************************************
'Option Explicit
Const ZesiZable As Boolean = True    ' false si on ne veux pas qu'il soit redimentionable
Dim oldx#, oldy#
Private Sub UserForm_MouseDown(ByVal button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    oldx = X: oldy = Y
End Sub

Private Sub UserForm_MouseMove(ByVal button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If ZesiZable Then
        Dim mp As Variant, H$, Coté$
        If Y < 20 Then H = "H" Else H = "M"
        If Y > Me.InsideHeight - 20 Then H = "B"
        If X < 20 Then Coté = "G" Else Coté = "M"
        If X > Me.InsideWidth - 20 Then Coté = "D"
        mp = H & Coté
        mp = Switch(mp = "HG", 8, mp = "BD", 8, mp = "HD", 6, mp = "BG", 6, mp = "HM", 7, mp = "BM", 7, mp = "MM", 0, mp = "MG", 9, mp = "MD", 9)
        If Me.MousePointer <> mp Then Me.MousePointer = mp
        If button = 1 Then
            xx = X + 20
          Select Case H & Coté
            Case "MM": Me.Left = Me.Left + (X - oldx): Me.Top = Me.Top + (Y - oldy): Exit Sub
            Case "HG": Me.Width = Me.Width - X: Me.Left = Me.Left + X: Me.Height = Me.Height - Y: Me.Top = Me.Top + Y
            Case "HD": Me.Width = X: Me.Height = Me.Height - Y: Me.Top = Me.Top + (Y)
            Case "BG": Me.Width = Me.Width - X: Me.Left = Me.Left + X: Me.Height = Y + 20
            Case "BD": Me.Width = X: Me.Height = Y + 20
            Case "MG": Me.Width = Me.Width - X: Me.Left = Me.Left + X
            Case "MD": Me.Width = X
            Case "HM": Me.Height = Me.Height - Y: Me.Top = Me.Top + (Y)
            Case "BM": Me.Height = Y + 20
             End Select
        End If
    End If
End Sub

démonstration

et noyeux joel

 

[Fabien35200]

salut Patrick
merci pour le Kado
Il ne m adapte pas le contenu en fonction de la fentre,donc je pense qu au final je garder le button spin de Jean Paul et ajouter ton code.
Merci beaucoup les gars.

 

[patricktoulon]

a ben le contenu il faut le zoomer au prorata de la modif userform bien sur
je répond simplement au titre explicite de la demande
si tu veux le resize des controls avec pas de soucis de je te le donne

 

[Fabien35200]

ca serait avec plaisir avec le resize des controls merci par avance.

 

[patricktoulon]

re
ben voila

'*********************************************************************************
'                       Collection UserForm Patricktoulon                        *
'                USERFORM REDIMENTIONABLE AVEC LA SOURIS SANS API                *
'                                                                                *
'Auteur:patricktoulon sur Exceldownload                                          *
'version 2.0 sans controls label pilote                                          *
'date version :24/03/2020                                                        *
'l'userform est redimmentionnable par les 4 cotés et les 4 angles                *
'le mouse pointeur vous indique le sens et le type de redimmentionnement         *
'une contante booleenne au depart pour decider si il est resizable ou pas        *
'*********************************************************************************
'Option Explicit
Const ZesiZable As Boolean = True    ' false si on ne veux pas qu'il soit redimentionable
Dim oldx#, oldy#
Dim large As Long
Dim haut As Long

Private Sub UserForm_Activate()
With Me: large = .Width: haut = .Height: End With
For Each ctrl In Me.Controls
        With ctrl
            .Tag = .Left & ";" & .Top & ";" & .Width & ";" & .Height
            On Error Resume Next
            .Tag = .Tag & ";" & .Font.Size
            Err.Clear
        End With
    Next
End Sub

Private Sub UserForm_MouseDown(ByVal button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    oldx = X: oldy = Y
End Sub

Private Sub UserForm_MouseMove(ByVal button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If ZesiZable Then
        Dim mp As Variant, H$, Coté$
        If Y < 20 Then H = "H" Else H = "M"
        If Y > Me.InsideHeight - 20 Then H = "B"
        If X < 20 Then Coté = "G" Else Coté = "M"
        If X > Me.InsideWidth - 20 Then Coté = "D"
        mp = H & Coté
        mp = Switch(mp = "HG", 8, mp = "BD", 8, mp = "HD", 6, mp = "BG", 6, mp = "HM", 7, mp = "BM", 7, mp = "MM", 0, mp = "MG", 9, mp = "MD", 9)
        If Me.MousePointer <> mp Then Me.MousePointer = mp
        If button = 1 Then
            xx = X + 20
          Select Case H & Coté
            Case "MM": Me.Left = Me.Left + (X - oldx): Me.Top = Me.Top + (Y - oldy): Exit Sub
            Case "HG": Me.Width = Me.Width - X: Me.Left = Me.Left + X: Me.Height = Me.Height - Y: Me.Top = Me.Top + Y
            Case "HD": Me.Width = X: Me.Height = Me.Height - Y: Me.Top = Me.Top + (Y)
            Case "BG": Me.Width = Me.Width - X: Me.Left = Me.Left + X: Me.Height = Y + 20
            Case "BD": Me.Width = X: Me.Height = Y + 20
            Case "MG": Me.Width = Me.Width - X: Me.Left = Me.Left + X
            Case "MD": Me.Width = X
            Case "HM": Me.Height = Me.Height - Y: Me.Top = Me.Top + (Y)
            Case "BM": Me.Height = Y + 20
             End Select
        End If
    End If
End Sub

Private Sub UserForm_Resize()
   Dim coeff
   newlarge = Me.Width / large
    newhaut = Me.Height / haut
    For Each ctrl In Me.Controls
        With ctrl
            mem = Split(.Tag, ";")
            .Left = mem(0) * newlarge: .Width = mem(2) * newlarge
            .Top = mem(1) * newhaut: .Height = mem(3) * newhaut
            On Error Resume Next
            coeff = IIf(newlarge < newhaut, newlarge, newhaut)
            .Font.Size = mem(4) * coeff
            Err.Clear
        End With
    Next

End Sub

demonstration

voila ton userform en caoutchouc

 

[VIARD]

Bonjour Patrick, Fabien, Galougalou

@fabien, il faut que le (spinButton) soit placé en haut à gauche dans l'user.
@patrick, je n'ai pas essayé, les composants à l'intérieur suivent-ils le mouvement.

 

[patricktoulon]

maintenant je peut te simplifier le truc avec les api au black compatible 32/64 si tu veux

 

[VIARD]

Désolé Patrick je n'ai pas vu ta réponse.

 

[patricktoulon]

@VIARD BONJOUR
VOIR MA DEMO
ils suivent

 

[Fabien35200]

Merci enormement pour le code
par contre ,je suis debutant, qu est qu un api?