تكبير وتصغير ووضع يوزرفورم على شريط الادوات والتحكم بإغلاقة

أكاديمية الصقر للتدريب أكتوبر 15, 2024 اكسيل شروحات فيديو, اكسيل شروحات ودروس, قسم الاكسيل اضف تعليق 51 زيارة

السلام عليكم ورحمة الله وبركاته

موضوعنا اليوم يمكن ان يكون هناك الكثير من الموضيع تطرقت الية ولكن بخبرتى المتواضعه لم يكن هناك موضوع كامل يخصه ودائما اثناء البحث سابقا ما كنت اجد الكثير من القصور بالامر

ولكن اليوم اقدم لكم تجميعه رائعة للتحكم لليوزرفورم من :-

1- تكبيرة وتصغيرة من تكبير كل الدوات علية وتصغيرها معه.
2- وضع علامة Minimize اى علاومة (-) المسؤلة عن تنزيل الفورم الى شريط الادوات.
3- عند اخفاء ملف الاكسيل لا يختفي وجودة من على شريط الادوات الخاص بالوندوز.
4- التحكم في زر اغلاق وفتح الفورم من تفعيلة ام لا.
5- اخفاء كل عناصر الفورم من تكبير وتصغير وووضع بشريط الادوات واغلاق من عدمه.
6- تسمية شريط الادوات الذى يظهر بملف بشريط ادوات الوندوز بأسم الفورم.

وعلية يجب عمل مديول جديد ووضع هذا الكود بداخل

بسم الله نبدأ بالشرح :_

اولا الموضوع تجميعة من الكثير من الموضوعات والعمل على تجميعهم بموضوع واحد من اجل الوصول لهذا العمل الى ان شاء الله هيكون رائع.

CODE

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function FindWindowA Lib "User32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function GetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLongA As Long) As Long
    Private Declare PtrSafe Function SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
        ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags 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 GetActiveWindow Lib "user32.dll" () As Long
    Private Declare PtrSafe Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
         ByVal wParam As Long, lParam As Any) As Long
    Private Declare PtrSafe Function DrawMenuBar Lib "User32" (ByVal hWnd As Long) As Long
    
    Private Declare PtrSafe Function GetSystemMenu Lib "User32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
    Private Declare PtrSafe Function GetMenuItemCount Lib "User32" (ByVal hMenu As Long) As Long
    Private Declare PtrSafe Function EnableMenuItem Lib "User32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, _
        ByVal wEnable As Long) 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
    
#Else
   ' Private
   Declare Function FindWindowA Lib "User32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   Declare Function GetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
   Declare Function SetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   Private Declare Function SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
        ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
   Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
   Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
   Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
         ByVal wParam As Long, lParam As Any) As Long
   Private Declare Function DrawMenuBar Lib "User32" (ByVal hWnd As Long) As Long
   
   Private Declare Function GetSystemMenu Lib "User32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
   Private Declare Function GetMenuItemCount Lib "User32" (ByVal hMenu As Long) As Long
   Private Declare Function EnableMenuItem Lib "User32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, _
        ByVal wEnable As Long) As Long
   Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
    ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
   
#End If

' Déclaration des constantes
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_FULLSIZING = &H70000
'تكبير وتصغير ووشريط التول بار
'Constants
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&
' لاخفاء الايقونات بالشريط
Private Const mcGWL_STYLE = (-16)
Private Const mcWS_SYSMENU = &H80000
'تفعيل الغاء وتشغيل اغلاق الفورم
Private Const MF_ENABLED = &H0&
Private Const MF_DISABLED = &H2&
Private Const MF_BYPOSITION = &H400
Private Const C_USERFORM_CLASSNAME = "ThunderDFrame"




'Attention, envoyer après changement du caption de l'UF
Public Sub InitMaxMin(mCaption As String, Optional Max As Boolean = True, Optional Min As Boolean = True _
        , Optional Sizing As Boolean = True)
        On Error Resume Next
Dim hWnd As Long
    hWnd = FindWindowA(vbNullString, mCaption)
    If Max Then SetWindowLongA hWnd, GWL_STYLE, GetWindowLongA(hWnd, GWL_STYLE) Or WS_MAXIMIZEBOX
    If Min Then SetWindowLongA hWnd, GWL_STYLE, GetWindowLongA(hWnd, GWL_STYLE) Or WS_MINIMIZEBOX
    If Sizing Then SetWindowLongA hWnd, GWL_STYLE, GetWindowLongA(hWnd, GWL_STYLE) Or WS_FULLSIZING
End Sub

Sub AddIcon(myForm)
'Add an icon on the titlebar
    Dim hWnd As Long
    Dim lngRet As Long
    Dim hIcon As Long
    hIcon = Sheet1.Image1.Picture.Handle
    hWnd = FindWindow(vbNullString, myForm.Caption)
    lngRet = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
    lngRet = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
    lngRet = DrawMenuBar(hWnd)
End Sub

 Sub AddMinimizeButton()
'Add a Minimize button to Userform
    Dim hWnd As Long
    hWnd = GetActiveWindow
    Call SetWindowLongA(hWnd, GWL_STYLE, _
                       GetWindowLongA(hWnd, GWL_STYLE) Or _
                       WS_MINIMIZEBOX)
    Call SetWindowPos(hWnd, 0, 0, 0, 0, 0, _
                      SWP_FRAMECHANGED Or _
                      SWP_NOMOVE Or _
                      SWP_NOSIZE)
End Sub

 Sub AppTasklist(myForm)
'Add this userform into the Task bar
        Dim WStyle As Long
        Dim Result As Long
        Dim hWnd As Long

    hWnd = FindWindow(vbNullString, myForm.Caption)
    WStyle = GetWindowLongA(hWnd, GWL_EXSTYLE)
    WStyle = WStyle Or WS_EX_APPWINDOW
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_HIDEWINDOW)
    Result = SetWindowLongA(hWnd, GWL_EXSTYLE, WStyle)
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_SHOWWINDOW)
End Sub

Public Sub subRemoveCloseButton(frm As Object)
    Dim lngStyle As Long
    Dim lngHWnd As Long

    lngHWnd = FindWindow(vbNullString, frm.Caption)
    lngStyle = GetWindowLongA(lngHWnd, mcGWL_STYLE)

    If lngStyle And mcWS_SYSMENU > 0 Then
        SetWindowLongA lngHWnd, mcGWL_STYLE, (lngStyle And Not mcWS_SYSMENU)
    End If

End Sub


Function EnableCloseButton(UF As MSForms.UserForm, Disable As Boolean) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' EnableCloseButton
' This function enables (if Disable is False) or disables (if
' Disable is True) the "X" button on a UserForm UF.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim UFHWnd As Long
Dim hMenu As Long
Dim ItemCount As Long
Dim Res As Long

' Get the HWnd of the UserForm.
UFHWnd = HWndOfUserForm(UF)
If UFHWnd = 0 Then
    EnableCloseButton = False
    Exit Function
End If
' Get the menu handle
hMenu = GetSystemMenu(UFHWnd, 0&)
If hMenu = 0 Then
    EnableCloseButton = False
    Exit Function
End If

ItemCount = GetMenuItemCount(hMenu)
If Disable = True Then
    Res = EnableMenuItem(hMenu, ItemCount - 1, MF_DISABLED Or MF_BYPOSITION)
Else
    Res = EnableMenuItem(hMenu, ItemCount - 1, MF_ENABLED Or MF_BYPOSITION)
End If
If Res = -1 Then
    EnableCloseButton = False
    Exit Function
End If
DrawMenuBar UFHWnd

EnableCloseButton = True


End Function

Function HWndOfUserForm(UF As MSForms.UserForm) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' HWndOfUserForm
' This returns the window handle (HWnd) of the userform referenced
' by UF. It first looks for a top-level window, then a child
' of the Application window, then a child of the ActiveWindow.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim AppHWnd As Long
Dim DeskHWnd As Long
Dim WinHWnd As Long
Dim UFHWnd As Long
Dim Cap As String
Dim WindowCap As String

Cap = UF.Caption

' First, look in top level windows
UFHWnd = FindWindow(C_USERFORM_CLASSNAME, Cap)
If UFHWnd <> 0 Then
    HWndOfUserForm = UFHWnd
    Exit Function
End If
' Not a top level window. Search for child of application.
AppHWnd = Application.hWnd
UFHWnd = FindWindowEx(AppHWnd, 0&, C_USERFORM_CLASSNAME, Cap)
If UFHWnd <> 0 Then
    HWndOfUserForm = UFHWnd
    Exit Function
End If
' Not a child of the application.
' Search for child of ActiveWindow (Excel's ActiveWindow, not
' Window's ActiveWindow).
If Application.ActiveWindow Is Nothing Then
    HWndOfUserForm = 0
    Exit Function
End If
'WinHWnd = WindowHWnd(Application.ActiveWindow)
UFHWnd = FindWindowEx(WinHWnd, 0&, C_USERFORM_CLASSNAME, Cap)
HWndOfUserForm = UFHWnd

End Function

وبه مجموعة من الاكواد المسؤله عن استدعاء المكتبات المسؤاله عن تفعيل ما هو اتى .

قبل الشرح يجب توضيح بعض الامور
الاول وهو

يجب وضع تلك المتغيرات باعلى الكود الخاص بالفورم حتى تكون مرجع عام ويجب التأكيد عليها لانها المسؤاله عن أخذ المقسات الخاصة بالفورم وتعديلاها مستقبلا وهى :-

CODE

Option Explicit<br />
Dim Lg As Single<br />
Dim Ht As Single<br />
Dim Fini As Boolean

ثانيا بحدث يوزرفورم اكتيف يوضع الكود التالى وبعد قليل سيتم شرح كل سطر على حدى

CODE

Private Sub UserForm_Activate()

    Dim B As Boolean
    'لإخفاء العناصر على شريط الفورم
    'subRemoveCloseButton Me
    'إخفاء ملف الإكسيل
    'Application.Visible = False
    AddMinimizeButton   'Add a Minimize button to Userform
    'لتسمية شريط المهام بإسم الفورم
    AppTasklist Me    'Add this userform into the Task bar
    'لاغلاق خاصية الخروج
    B = EnableCloseButton(UF:=Me, Disable:=True)
    'لتفعيل تكبير وتصغير الفورم ووضع التكبير بشريط الفورم
    InitMaxMin Me.Caption
    '==============
    Ht = Me.Height
    Lg = Me.Width
    Application.WindowState = xlMaximized
End Sub

ثالثا وضع الكود التالى بحدث UserForm_Resize والمسؤال عن تغير حجم الفورم

CODE

Private Sub UserForm_Resize()

    Dim RtL As Single, RtH As Single
        If Me.Width < 300 Or Me.Height < 200 Or Fini Then Exit Sub
        RtL = Me.Width / Lg
        RtH = Me.Height / Ht
        Me.Zoom = IIf(RtL < RtH, RtL, RtH) * 100
End Sub

والان نأتي لشرح كل سطر في اليوزرم فورم اكتيف

الاعلان عن متغير B

CODE

&nbsp; &nbsp; Dim B As Boolean

والمسؤال عن هذا السطر

CODE

    'لاغلاق خاصية الخروج
    B = EnableCloseButton(UF:=Me, Disable:=True)

والذى يكون مهمته التحكم في زر الاغلاق للفورم بالتفعيل او ايقاف تفعيله

2- السطر التالى

CODE

    'لإخفاء العناصر على شريط الفورم
    'subRemoveCloseButton Me

والمسؤال عن اخفاء عناصر الفورم من اغلاق وتكبير وتصغير يمكن الاعتماد علية وحده في بعض الفورمز وعدم تفعيل الباقي

3- السطر التالى لاخفاء ملف الاكسيل

CODE

Application.Visible = False

4- السطر التالى المسؤل عن وضع علامة (-) بالفورم والتى تنزلة لشريط ادولات الوندوز من عدمة

CODE

 AddMinimizeButton   'Add a Minimize button to Userform

5- السطر التالى له ميزات كثيرة ومنها

أ – انه في حالة اخفاء ملف الاكسيل كلنا عارفين ان حتى لو فتحين فورم لن تجد بشريط الادوات ما يدل على فتح الفورم او ملف الاكسيل

ب- ان يظهر شريط الادوات ويدل على فتح الملف وايضا يظهر الاسم علية باسم الفورم

CODE

    'لتسمية شريط المهام بإسم الفورم
    AppTasklist Me    'Add this userform into the Task bar

6- السطر التالى لتكبير وتصغير الفورم بالعناصر التى علية

CODE

    'لتفعيل تكبير وتصغير الفورم ووضع التكبير بشريط الفورم
    InitMaxMin Me.Caption

وايضا يجب ان يكون الكود الخاص UserForm_Resize موضوع كما تم الايضاح بالاعلى حتى تتغير عناصر الفورم بتغير حجمه

7- السطور التالية مسؤاله عن تكبير ملف العمل لحجم شاشة العمل وايضا لتكبير الفورم لنفس الحجم او تصغيرة وهؤالاء يجب وضعهم ايضا للتحكم في حجم الفورم

CODE

&nbsp; &nbsp; Ht = Me.Height<br />
&nbsp; &nbsp; Lg = Me.Width<br />
&nbsp; &nbsp; Application.WindowState = xlMaximized

وفي النهاية يجي واحد كان نايم اثناء الشرح ويقول يا انته بتقول ايه ايه الهلوغريفي الى انته بتقوله ده اقوله ولا تشغل بالك

التالى هو شرح قام به الاستاذ الغالي استاذ اسلام عبدالله على قناة الاكاديمية على اليوتوب يمكن الرجوع الية لتوضيح الامر صوت وصورة وشاكر جدا تعبه معايا

https://youtube.com/watch?v=ShFeisBMmZM%26feature%3Dyoutu.be%26fbclid%3DIwAR13mvVIK5eKP8UzbPEInlSyDfN8nyq1xmvq3LgnujRXfG29r_4GkRXeq7Q

ومرفق مثال عملى المستخدم بالشرح

User-form-library.rar

وبالنهاية تقبلوا جميعا تحياتى وتقديرى واتمنى ان ينول الموضوع اعجابكم وان يلبي طلباتكم

عن أكاديمية الصقر للتدريب

أكاديمية الصقر للتدريب تقدم العديد من الشروحات والكورسات والحلول والمشاريع الجاهزة والبرامج المجانية فقط قم بالتسجيل في المنتدى واستمتع بكل مميزات الاكاديمية

شاهد أيضاً

برنامج المخازن Ystore – ياسر العربي معدل

بسم الله الرحمن الرحيم تم عمل تعديل لبرنامج Ystoreواصلاح اغلب المشكلات التي كانت موجودة مسبقالتحميل …

اترك تعليقاً

لن يتم نشر عنوان بريدك الإلكتروني. الحقول الإلزامية مشار إليها بـ *

Powered by WordPress | Designed by TieLabs
© Copyright 2024, All Rights Reserved