اذهب الي المحتوي
أوفيسنا

إظهار الفورم بدون زر الإغلاق


الردود الموصى بها

وعليكم السلام أخي الغالي أبا الحسن والحسين

إضافة لما تفضلت به في الملف المرفق من الكود ..إضافة بسيطة جداً لكي يعمل الكود على كلا النظامين 32 بت و64 بت (حيث أن الملف المرفق في المشاركة الخاصة بك سيعمل على 64 بت فقط)

استبدال أسطر الإعلانات العامة في الموديول بهذه الأسطر

#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare PtrSafe Function DrawMenuBar Lib "User32" (ByVal hwnd As LongPtr) As Long
#Else
    Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" ( ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" ( ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function DrawMenuBar Lib "User32" ( ByVal hwnd As Long) As Long
#End If

ليصبح الكود النهائي بهذا الشكل (الكود يوضع في حدث الفورم )

#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare PtrSafe Function DrawMenuBar Lib "User32" (ByVal hwnd As LongPtr) As Long
#Else
    Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" ( ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" ( ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function DrawMenuBar Lib "User32" ( ByVal hwnd As Long) As Long
#End If

Sub RemoveCaption(objForm As Object)
    
    Dim lStyle          As Long
    Dim hMenu           As Long
    Dim mhWndForm       As Long
    
    If Val(Application.Version) < 9 Then
        mhWndForm = FindWindow("ThunderXFrame", objForm.Caption) 'XL97
    Else
        mhWndForm = FindWindow("ThunderDFrame", objForm.Caption) 'XL2000+
    End If
    lStyle = GetWindowLong(mhWndForm, -16)
    lStyle = lStyle And Not &HC00000
    SetWindowLong mhWndForm, -16, lStyle
    DrawMenuBar mhWndForm
    
End Sub

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Call RemoveCaption(Me)
End Sub

 

ونقطة أخيرة للاستفادة الكاملة من الكود

يمكنك وضع الإعلانات العامة والإجراء المسمى RemoveCaption في موديول عادي ..بينما يوضع حدث زر الأمر وحدث بدء تشغيل الفورم في حدث الفورم أي يمكن الفصل بينهما

تقبل تحياتي

  • Like 4
رابط هذا التعليق
شارك

بارك الله فيك أخي الفاضل KHMB على هذا الحل الرائع وجزيت خير الجزاء

وشكرا لك أخي العزيز ياسر خليل ..دائما ما تعجبني أجوبتك .. وفقكم الله لكل خير .. واطال في أعماركم

  • Like 1
رابط هذا التعليق
شارك

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

اخي العزيز الاستاذ الفاضل / ياسر خليل

بارك الله فيك رائع جدا فعلا ممكن لايعمل عند الكثير لان الاغلبية يعمل علي نظام 32 بت

جزاك الله خير

  • Like 1
رابط هذا التعليق
شارك

أخي الكريم مهند

الحمد لله أن تم المطلوب على خير .. وإلى لقاء في موضوعات أخرى

تقبل وافر تقديري واحترامي

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information