vivre-motion
Excel 现代 GUI VBA 接口
SKU: VM-70018
-
正常价格
-
€ 0,00 EUR
-
正常价格
-
€ 3,00 EUR
-
销售价格
-
€ 0,00 EUR
- 单价
-
/
每
销售
售罄
干净的Excel界面设计
无框架 DWM API VBA 用户窗体
使用具有 SoftShadow 效果的无框现代界面模板表单，将您的 Excel（用户窗体）用户界面提升到一个新的干净级别，如 Windows 11。
VBA 源代码
选项显式
'//////////////////////////////////////////////// ///////////////////////////////////
私有声明 PtrSafe 函数 SendMessage Lib“user32”别名“SendMessageA”（ByVal H_WINDOW As Long，ByVal wMsg As Long，ByVal wParam As Long，lParam As Any）
Private Declare PtrSafe Function ReleaseCapture Lib "user32" () As Long
私有声明 PtrSafe 函数 ShellExecute Lib“shell32.dll”别名“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）
私有声明 PtrSafe 函数 SetWindowLong Lib "user32" 别名 "SetWindowLongA" (ByVal H_WINDOW As Long, ByVal lngWinIdx As Long, ByVal dwNewLong As Long)
私有声明 PtrSafe 函数 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal H_WINDOW As Long, ByVal lngWinIdx As Long)
私有声明 PtrSafe 函数 SetLayeredWindowAttributes Lib "user32" (ByVal H_WINDOW As Long, ByVal crKey As Integer, ByVal bAlpha As Integer, ByVal dwFlags As Long)
Private Declare PtrSafe Function FindWindow Lib "user32" 别名 "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
私有声明 PtrSafe 函数 GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
私有声明 PtrSafe 函数 DwmSetWindowAttribute Lib“dwmapi”（ByVal hWnd As Long，ByVal attr As Integer，ByRef attrValue As Integer，ByVal attrSize As Long）
私有声明 PtrSafe 函数 DwmExtendFrameIntoClientArea Lib "dwmapi" (ByVal hWnd As Long, ByRef NEWMARGINS As MARGINS) As Long
'//////////////////////////////////////////////// ///////////////////////////////////
私有常数 GWL_STYLE = (-16)
Private Const WS_CAPTION = &HC00000 '//// WS_BORDER 或 WS_DLGFRAME
私有常量 WS_BORDER = &H800000
Private Const GWL_EXSTYLE As Long = (-20) '//// 窗口扩展样式的偏移量
Private Const WS_EX_DLGMODALFRAME As Long = &H1 '//// 如果窗口有图标则控制
Private Const SC_CLOSE As Long = &HF060
私有常量 SW_SHOW As Long = 5
私有常量 WS_EX_LAYERED = &H80000
私人常量 LWA_COLORKEY = &H1
私有常数 LWA_ALPHA = &H2
私有常量 WS_EX_TRANSPARENT = &H20&
'//////////////////////////////////////////////// ///////////////////////////////////
私有枚举 ESetWindowPosStyles
SWP_SHOWWINDOW = &H40
SWP_HIDEWINDOW = &H80
SWP_FRAMECHANGED = &H20 '//// 帧已更改发送 WM_NCCALCSIZE
SWP_NOACTIVATE = &H10
SWP_NOCOPYBITS = &H100
SWP_NOMOVE = &H2
SWP_NOOWNERZORDER = &H200 '// 不要进行所有者 Z 排序
SWP_NOREDRAW = &H8
SWP_NOREPOSITION = SWP_NOOWNERZORDER
SWP_NOSIZE = &H1
SWP_NOZORDER = &H4
SWP_DRAWFRAME = SWP_FRAMECHANGED
HWND_NOTOPMOST = -2
结束枚举
'//////////////////////////////////////////////// //////////////////////////////////////////////// //////////////////////////////////////////////// //
私有类型保证金
左一样长
TOP 只要
权利只要
底部一样长
结束类型
'//////////////////////////////////////////////// ///////////////////////////////////
私有常量 HTCAPTION = 2
私有XWNDFORM，XWNDFORMEX一样长
私有常量 WM_NCLBUTTONDOWN = &HA1
'//////////////////////////////////////////////// ///////////////////////////////////
私有子 UserForm_Initialize()
昏暗的 ISTYLE，HWNDFORM 一样长
将 btrans 变暗为字节
btrans = 128
将 NEWMARGINS 调暗为边距
HWNDFORM = FindWindow(vbNullString, Me.Caption) '//// 获取窗口
ISTYLE = GetWindowLong(HWNDFORM, GWL_STYLE) '//// 基本窗口 STYLE 窗体标志
ISTYLE = ISTYLE And Not WS_CAPTION '//// 没有标题区域
SetWindowLong HWNDFORM, GWL_STYLE, ISTYLE '//// 设置基本窗口样式
ISTYLE = GetWindowLong(HWNDFORM, GWL_EXSTYLE) '//// 构建扩展窗口样式
ISTYLE = ISTYLE 而不是 WS_EX_DLGMODALFRAME '//// 无边框
SetWindowLong HWNDFORM、GWL_EXSTYLE、ISTYLE
XWNDFORM = FindWindow("ThunderDFrame", vbNullString) '//// 获取新窗口
DwmSetWindowAttribute XWNDFORM, 2, 2, 4 '//// DWMAPI
随着NEWMARGINS
.BOTTOM = 1 '//// -1
.LEFT = 1 '//// -1
.RIGHT = 1 '//// -1
.TOP = 1 '//// -1
结束于
DwmExtendFrameIntoClientArea XWNDFORM, NEWMARGINS '//// DWMAPI
DrawMenuBar HWNDFORM '//// 清理菜单栏
结束子
'//////////////////////////////////////////////// ///////////////////////////////////
私有子 CMD_CLOSE_Click()
卸载我
结束子
'//////////////////////////////////////////////// ///////////////////////////////////
Private Sub UserForm_MouseDown（ByVal Button As Integer，ByVal Shift As Integer，ByVal X As Single，ByVal Y As Single）
如果按钮 = 1 那么
释放捕获
SendMessage XWNDFORM、WM_NCLBUTTONDOWN、HTCAPTION、0&
万一
结束子
'//////////////////////////////////////////////// ///////////////////////////////////
私有子 VIVRE_MOTION_Click()
调用 ShellExecute(0, "打开", "https://vivre-motion.com", "", vbNullString, 1)
结束子
分享
