متابعةً مع أستاذنا @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