Option Explicit
Dim hwnd&
'sub de transformation
Private Sub Nocaption()
Dim insideRect As Long, ptopx#, InsideTop#, InsideLeft#, InsidWidth#, InsidHeight#, insideMarge#, Arrondi&, CtrL
Arrondi = 25
With Me
.faussecaption = .Caption
.faussecaption.Width = .Width + 100
.Height = Me.Height + 21
.Top = .Top - 21
For Each CtrL In .Controls
If CtrL.Tag <> "XXX" Then CtrL.Top = CtrL.Top + 21
Next
End With
With ActiveWindow.ActivePane: ptopx = (.PointsToScreenPixelsX(72 / (.Parent.Zoom / 100)) - .PointsToScreenPixelsX(0)) / 72: End With
insideMarge = Round((Me.Width - Me.InsideWidth) * ptopx) - 1
InsideLeft = Round(((Me.Width - Me.InsideWidth) / 2) * ptopx)
InsideTop = Round((Me.Height - Me.InsideHeight) * ptopx) - (insideMarge - 2)
InsidWidth = Round(Me.InsideWidth * ptopx) + InsideLeft
InsidHeight = Round(Me.InsideHeight * ptopx) + InsideTop + insideMarge - 1
hwnd = ExecuteExcel4Macro("CALL(""user32"",""GetActiveWindow"",""JCC"")") 'api GetActiveWindow
insideRect = ExecuteExcel4Macro("CALL(""gdi32"",""CreateRoundRectRgn"",""JJJJJJJ""," & InsideLeft & ", " & InsideTop & ", " & InsidWidth & ", " & InsidHeight & ", " & Arrondi & ", " & Arrondi & ")")
ExecuteExcel4Macro ("CALL(""user32"",""SetWindowRgn"",""JJJJ""," & hwnd & ", " & insideRect & ", " & 1 & ")")
ExecuteExcel4Macro ("CALL(""gdi32"",""DeleteObject"",""JJ""," & insideRect & ")")
End Sub
'bouton de transformation
Private Sub CommandButton1_Click()
Nocaption
End Sub
'Drag le userform comme le fait la barre de titre d'origine
Private Sub faussecaption_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
ExecuteExcel4Macro "CALL(""user32"",""ReleaseCapture"",""JJJJJ"")"
ExecuteExcel4Macro "CALL(""user32"",""SendMessageA"",""JJJJJ"",""" & hwnd & """,""" & &HA1 & """,""" & 2& & """,""0"")"
End If
End Sub
Private Sub fermer_Click()
Unload Me
End Sub