'*********************************************************************************
' 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
