قم بإحضار واجهة مستخدم Excel (UserForm) إلى مستوى جديد نظيف مثل Windows 11 ، باستخدام نموذج قالب واجهة حديث بدون إطار مع تأثير SoftShadow.
كود مصدر VBA
خيار صريح
'///////////////////////////////////////////////////// /////////////////////////////////////////
إعلان خاص عن وظيفة PtrSafe SendMessage Lib "user32" اسم مستعار "SendMessageA" (ByVal H_WINDOW طويل ، ByVal wMsg طويل ، ByVal wParam طويل ، lParam مثل أي) طويلة
إعلان خاص وظيفة PtrSafe ReleaseCapture Lib "user32" () طالما
إعلان خاص دالة PtrSafe ShellExecute Lib "shell32.dll" اسم مستعار "ShellExecuteA" (ByVal hWnd As Long ، ByVal lpOperation As Long ، ByVal lpFile As String ، ByVal lpParameters As String ، ByVal lpDirectory As String ، ByVal nshowcmd As Long)
إعلان خاص تعيين وظيفة PtrSafeWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal H_WINDOW As Long ، ByVal lngWinIdx طويل ، ByVal dwNewLong طويل)
إعلان خاص دالة PtrSafe GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal H_WINDOW As Long ، ByVal lngWinIdx طويل) طويل
إعلان خاص تعيين دالة PtrSafe ليب "user32" (ByVal H_WINDOW طويل ، ByVal crKey كعدد صحيح ، ByVal bAlpha As Integer ، ByVal dwFlags طويل)
إعلان خاص دالة PtrSafe FindWindow Lib "user32" الاسم المستعار "FindWindowA" (ByVal lpClassName كسلسلة ، ByVal lpWindowName كسلسلة) طويلة
إعلان خاص دالة PtrSafe FindWindowEx Lib "user32" اسم مستعار "FindWindowExA" (ByVal hWnd1 طويل ، ByVal hWnd2 طويل ، ByVal lpsz1 كسلسلة ، ByVal lpsz2 كسلسلة) طويلة
إعلان خاص دالة PtrSafe DrawMenuBar Lib "user32" (ByVal H_WINDOW بطول طويل)
إعلان خاص دالة PtrSafe GetWindow Lib "user32" (ByVal hWnd طويل ، ByVal wCmd وطول)
إعلان خاص دالة PtrSafe DwmSetWindowAttribute Lib "dwmapi" (ByVal hWnd طويل ، ByVal Attr As Integer ، ByRef AttrValue As Integer ، ByVal AttrSize As Integer) طويل
إعلان خاص عن وظيفة PtrSafe DwmExtendFrameIntoClientArea Lib "dwmapi" (ByVal hWnd As Long ، ByRef NEWMARGINS as MarGINS) طويلة
'///////////////////////////////////////////////////// /////////////////////////////////////////
خاص Const GWL _ [_ 0127_45_] = (-16)
Const الخاصة WS_CAPTION = & amp؛ HC00000 '//// WS_BORDER أو WS_DLGFRAME
التأسيس الخاص WS_BORDER = & amp؛ H800000
GWL_EXSTYLE الخاص بالطول = (-20) '//// OFFSET OF WINDOW EXTENDED STYLE
الإطار الخاص WS_EX_DLGMODALFRAME بالطول = & amp؛ H1 '//// CONTROLS IF WINDOW لديه رمز
SC_CLOSE الخاص بالطول = & amp؛ HF060
SW_SHOW الخاص بالأرقام الطويلة = 5
التأسيس الخاص WS_EX_LAYERED = & amp؛ H80000
المصمم الخاص LWA_COLORKEY = & amp؛ H1
المصمم الخاص LWA_ALPHA = & amp؛ H2
التوزيع الخاص WS_EX_TRANSPARENT = & amp؛ H20 & amp؛
'///////////////////////////////////////////////////// /////////////////////////////////////////
Enum الخاص ESetWindowPosStyles
SWP_SHOWWINDOW = & amp؛ H40
SWP_HIDEWINDOW = & amp؛ H80
SWP_FRAMECHANGED = & amp؛ H20 '//// تغيير الإطار أرسل WM_NCCALCSIZE
SWP_NOACTIVATE = & amp؛ H10
SWP_NOCOPYBITS = & amp؛ H100
SWP_NOMOVE = & amp؛ H2
SWP_NOOWNERZORDER = & amp؛ H200 '// لا تفعل مالك Z الطلب
SWP_NOREDRAW = & amp؛ H8
SWP_NOREPOSITION = SWP_NOOWNERZORDER
SWP_NOSIZE = & amp؛ H1
SWP_NOZORDER = & amp؛ H4
SWP_DRAWFRAME = SWP_FRAMECHANGED
HWND_NOTOPMOST = -2
End Enum
'///////////////////////////////////////////////////// ////////////////////////////////////////////////////// ////////////////////////////////////////////////////// //
نوع خاص هوامش
اليسار طالما
توب طويل
حق طويل
الأسفل بالطول
نوع النهاية
'///////////////////////////////////////////////////// /////////////////////////////////////////
HTCAPTION الخاص CONSTAPTION = 2
XWNDFORM الخاص ، XWNDFORMEX As Long
Const الخاصة WM_NCLBUTTONDOWN = & amp؛ HA1
'///////////////////////////////////////////////////// /////////////////////////////////////////
UserForm_Initialize فرعي خاص ()
قاتمة ISTYLE ، HWNDFORM طالما
Dim btrans As Byte
btrans = 128
خافت NEWMARGINS على شكل هوامش
HWNDFORM = FindWindow (vbNullString، Me.Caption) '//// GET WINDOW
ISTYLE = GetWindowLong (HWNDFORM، GWL _ [_ 0127_45_]) '//// BASIC WINDOW STYLE FLAGS FORM
ISTYLE = ISTYLE وليس WS_CAPTION '//// NO CAPTION AREA
SetWindowLong HWNDFORM، GWL _ [_ 0127_45_]، ISTYLE '//// SET BASIC WINDOW STYLES
ISTYLE = GetWindowLong (HWNDFORM، GWL_EXSTYLE) "//// BUILD EXTENDED WINDOW STYLE
ISTYLE = ISTYLE وليس WS_EX_DLGMODALFRAME '//// NO BORDER
SetWindowLong HWNDFORM ، GWL_EXSTYLE ، ISTYLE
XWNDFORM = FindWindow ("ThunderDFrame"، vbNullString) "//// GET NEW WINDOW
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 '//// CLEAN MENU BAR
End Sub
'///////////////////////////////////////////////////// /////////////////////////////////////////
خاص Sub CMD_CLOSE_Click ()
تفريغ لي
End Sub
'///////////////////////////////////////////////////// /////////////////////////////////////////
Private Sub UserForm_MouseDown (زر ByVal كعدد صحيح ، ByVal Shift كعدد صحيح ، ByVal X مفرد ، ByVal Y فردي)
إذا كان الزر = 1 ثم
ReleaseCapture
SendMessage XWNDFORM، WM_NCLBUTTONDOWN، HTCAPTION، 0 & amp؛
إنهاء إذا
End Sub
'///////////////////////////////////////////////////// /////////////////////////////////////////
فرعي خاص VIVRE_MOTION_Click ()
استدعاء ShellExecute (0، "open"، "https://vivre-motion.com"، ""، vbNullString، 1)
End Sub
