فورم يختفي بشكل تدريجي ... كيف يمكن تركيب اكواده ؟؟

[رائد 1982]

الاساتذة الافاضل

شاهدت في العديد من الملفات للخبراء الكرام في بعض الموضوعات الرائعة

فورم عند الدخول وكذلك عند الضغط علي زر بداخل الملف يظهر الفورم كالوضع العادي ولكن ايضا يختفي تدريجيا

مع التأكيد علي انه نفس الفورم المستخدم عند الدخول مباشرة وعند الضغط علي الزر من داخل الملف

 

مع العلم انني قد حاولت كثيرا لنسخ الاكواد الموجودة في الملفات المذكورة ولكن دون جدوي

حيث ان خبرتي بالاكواد قليلة ... ولم استطع التعرف علي الاكواد التي تفعل ذلك بمفردها  ... والفورم موجود بالملف ينقصه الاكواد

جزاكم الله خيرا

 

 

 

 

فورم يختفي بشكل تدريجي.rar

[حمادة عمر]

السلام عليكم

الاخ الكريم / رائد

بارك الله فيك

اولا : اخي الكريم لاظهار الفورم عند فتح الملف يجب عليك وضع الكود التالي في حدث ThisWorkbook

Private Sub Workbook_Open()
UserForm1.Show
End Sub

ثانيا : لاظهار الفورم عن طريق استخدام الزر في داخل الملف ... قم بوضع هذا الكود في مودل جديد مثلا

Sub sama()
UserForm1.Show
End Sub

ثالثا : للقيام بجعل الفورم يختفي تدريجيا نقوم بوضع الاكواد التاليه في اكواد الفورم نفسه ... وهي كالتالي

Option Explicit

Private Declare Function GetActiveWindow Lib "USER32" () As Long
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal lngWinIdx As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal lngWinIdx As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "USER32" _
(ByVal hWnd As Long, _
ByVal crKey As Integer, _
ByVal bAlpha As Integer, _
ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC

Dim hWnd            As Long
Dim Transparancy    As Integer
Dim Running         As Boolean

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub UserForm_Activate()
Running = True
Call Transparency
End Sub
Private Sub Transparency()
Dim MyTimer         As Double
    DoEvents
    MyTimer = Timer
    Do
        Do
        Loop While Timer - MyTimer < 0.07
        MyTimer = Timer
        Transparancy = Transparancy - 1
        If Transparancy < 0 Then
            Unload Me
            Else
            Call SemiTransparent(Application.WorksheetFunction.Min(Transparancy, 100))
        End If
        DoEvents
    Loop While Running
End Sub

Private Sub SemiTransparent(ByVal intLevel As Integer)
Dim lngWinIdx       As Long
    hWnd = GetActiveWindow
    lngWinIdx = GetWindowLong(hWnd, GWL_EXSTYLE)
    SetWindowLong hWnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
    SetLayeredWindowAttributes hWnd, 0, (255 * intLevel) / 100, LWA_ALPHA
End Sub

Private Sub UserForm_Initialize()
    Transparancy = 120
    Call SemiTransparent(100)
    DoEvents
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Running = False
End Sub

وبذلك سيعمل معك الفورم بالشكل الذي تريده ويظهر في بداية تشغيل الملف ثم يختفي تدريجيا

وعند الضغط علي الزر بداخل الملف سيظهر الفورم ثم يختفي تدريجيا ايضا

ارجو ان يكون هذا هو طلبك ... واليك الملف المرفق به الاكواد السابقة

جزاك الله خيرا

 

 

فورم يختفي بشكل تدريجي1.rar

[رائد 1982]

الاستاذ القدير / حمادة عمر

بارك الله فيك

والله عند طرحي للسؤال كنت اتمني ان تقوم انت بالرد علي طلبي حيث ان طريقتك اكثر من راائعة

وتقوم بتوصيل المعلومة بشكل اكثر من ممتاز وبالفعل قمت بتنفيذ الخطوات

وتم الطريقة بنجاح تام

شاكر فضلك

جزاك الله خيرا

[حمادة عمر]

السلام عليكم

الاخ الكريم / رائد

بارك الله فيك

الحمد لله ان هداك لما تريد وتوصلت للمطلوب

جزاك الله خيرا