امر sleep مع progress bar

[tiger wanted]

بسم الله الرحمن الرحيم 

كيفية عمل progress bar باستخدام امر sleep دون استخدام خاصية ontimer وذلك للاهمية ولكم جزيل الشكر 

[Moosak]

السلام عليكم 🙂 

تفضل هذا شريط تقدم بدون استخدام التايمر  🙂 

 

شريط تقدم بدون تايمر.accdb

[tiger wanted]

الف شكر على هذه الاجابة الرائعة 

اطمع فى طلب اخر كيف يمكن تنفيذ استعلام تحديث والحاق مثلا اثناء عملية progress حتى لايقوم العميل باستعجال الاستعلام مثلا عند وصول الشريط الى 20 % يقوم بعمل استعلام معين

وعند 50 % يقوم بعمل استعلام اخر ارجو ان اكون قد اوضحت الفكرة 

[tiger wanted]

للرفع

 

[Foksh]

34 دقائق مضت, tiger wanted said:

للرفع

 

متابعةً مع أستاذنا @Moosak ، تم إضافة بعض التعديلات حسب طلبك . تفضل الكود أولاً .

Option Compare Database
Option Explicit

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private bMessage20Displayed As Boolean ' متغير لتتبع ما إذا تم عرض الرسالة عند 20%
Private bMessage50Displayed As Boolean ' متغير لتتبع ما إذا تم عرض الرسالة عند 50%

Private Sub StartBtn_Click()
    Call ResetProgressPar
    Call RunProgressPar
End Sub

Function ResetProgressPar()
    ' Reset
    Me.Par2.Left = Me.Par1.Left
    Me.Par2.Height = Me.Par1.Height
    Me.Par2.Width = 0
    Me.P = ""
    bMessage20Displayed = False ' إعادة تعيين قيمة المتغير
    bMessage50Displayed = False ' إعادة تعيين قيمة المتغير
End Function

Function RunProgressPar()
    ' Start
    Dim x As Long
    Dim percentage As Double
    
    For x = 1 To Par1.Width Step 2
        Me.Par2.Width = x
        percentage = CInt((x / Par1.Width) * 100)
        Me.P = percentage & "   %"
        
        If percentage = 20 And Not bMessage20Displayed Then
            MsgBox "20% progress. Press OK to continue.", vbInformation, "Progress Update"
            
            bMessage20Displayed = True
            
            Sleep 500
        End If
        
        If percentage = 50 And Not bMessage50Displayed Then
            MsgBox "50% progress. Press OK to continue.", vbInformation, "Progress Update"
            
            bMessage50Displayed = True
            
            Sleep 500
        End If
        
        DoEvents
    Next
End Function

 

تفضل المرفق ، طبعاً قم بتغيير حدث الرسالة بالحدث الذي ترغب به

شريط تقدم بدون تايمر.accdb

 

[tiger wanted]

الف شكر وجارى التجربة