Clean Excel interface Design
Frameless DWM API VBA UserForm
Bring your Excel (UserForm) User interface to a new clean Level like Windows 11, with the Frameless Modern Interface Template Form with SoftShadow Effect.
VBA Source Code
Option Explicit
'//////////////////////////////////////////////////////////////////////////////////////
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal H_WINDOW As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare PtrSafe Function ReleaseCapture Lib "user32" () As Long
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nshowcmd As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal H_WINDOW As Long, ByVal lngWinIdx As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal H_WINDOW As Long, ByVal lngWinIdx As Long) As Long
Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal H_WINDOW As Long, ByVal crKey As Integer, ByVal bAlpha As Integer, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal H_WINDOW As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare PtrSafe Function DwmSetWindowAttribute Lib "dwmapi" (ByVal hWnd As Long, ByVal attr As Integer, ByRef attrValue As Integer, ByVal attrSize As Integer) As Long
Private Declare PtrSafe Function DwmExtendFrameIntoClientArea Lib "dwmapi" (ByVal hWnd As Long, ByRef NEWMARGINS As MARGINS) As Long
'//////////////////////////////////////////////////////////////////////////////////////
Private Const GWL_STYLE = (-16)
Private Const WS_CAPTION = &HC00000 '//// WS_BORDER Or WS_DLGFRAME
Private Const WS_BORDER = &H800000
Private Const GWL_EXSTYLE As Long = (-20) '//// OFFSET OF WINDOW EXTENDED STYLE
Private Const WS_EX_DLGMODALFRAME As Long = &H1 '//// CONTROLS IF WINDOW HAS AN ICON
Private Const SC_CLOSE As Long = &HF060
Private Const SW_SHOW As Long = 5
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const WS_EX_TRANSPARENT = &H20&
'//////////////////////////////////////////////////////////////////////////////////////
Private Enum ESetWindowPosStyles
SWP_SHOWWINDOW = &H40
SWP_HIDEWINDOW = &H80
SWP_FRAMECHANGED = &H20 '//// FRAME CHANGED SEND WM_NCCALCSIZE
SWP_NOACTIVATE = &H10
SWP_NOCOPYBITS = &H100
SWP_NOMOVE = &H2
SWP_NOOWNERZORDER = &H200 '// DONT DO OWNER Z ORDERING
SWP_NOREDRAW = &H8
SWP_NOREPOSITION = SWP_NOOWNERZORDER
SWP_NOSIZE = &H1
SWP_NOZORDER = &H4
SWP_DRAWFRAME = SWP_FRAMECHANGED
HWND_NOTOPMOST = -2
End Enum
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Type MARGINS
LEFT As Long
TOP As Long
RIGHT As Long
BOTTOM As Long
End Type
'//////////////////////////////////////////////////////////////////////////////////////
Private Const HTCAPTION = 2
Private XWNDFORM, XWNDFORMEX As Long
Private Const WM_NCLBUTTONDOWN = &HA1
'//////////////////////////////////////////////////////////////////////////////////////
Private Sub UserForm_Initialize()
Dim ISTYLE, HWNDFORM As Long
Dim btrans As Byte
btrans = 128
Dim NEWMARGINS As MARGINS
HWNDFORM = FindWindow(vbNullString, Me.Caption) '//// GET WINDOW
ISTYLE = GetWindowLong(HWNDFORM, GWL_STYLE) '//// BASIC WINDOW STYLE FLAGS FOR THE FORM
ISTYLE = ISTYLE And Not WS_CAPTION '//// NO CAPTION AREA
SetWindowLong HWNDFORM, GWL_STYLE, ISTYLE '//// SET BASIC WINDOW STYLES
ISTYLE = GetWindowLong(HWNDFORM, GWL_EXSTYLE) '//// BUILD EXTENDED WINDOW STYLE
ISTYLE = ISTYLE And Not WS_EX_DLGMODALFRAME '//// NO BORDER
SetWindowLong HWNDFORM, GWL_EXSTYLE, ISTYLE
XWNDFORM = FindWindow("ThunderDFrame", vbNullString) '//// GET NEW WINDOW
DwmSetWindowAttribute XWNDFORM, 2, 2, 4 '//// DWMAPI
With NEWMARGINS
.BOTTOM = 1 '//// -1
.LEFT = 1 '//// -1
.RIGHT = 1 '//// -1
.TOP = 1 '//// -1
End With
DwmExtendFrameIntoClientArea XWNDFORM, NEWMARGINS '//// DWMAPI
DrawMenuBar HWNDFORM '//// CLEAN MENU BAR
End Sub
'//////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_CLOSE_Click()
Unload Me
End Sub
'//////////////////////////////////////////////////////////////////////////////////////
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
ReleaseCapture
SendMessage XWNDFORM, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub
'//////////////////////////////////////////////////////////////////////////////////////
Private Sub VIVRE_MOTION_Click()
Call ShellExecute(0, "open", "https://vivre-motion.com", "", vbNullString, 1)
End Sub
