اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

قام بنشر

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

إضافة لما تفضلت به في الملف المرفق من الكود ..إضافة بسيطة جداً لكي يعمل الكود على كلا النظامين 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

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

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

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

Important Information