كود UserForm يتغير حسب المدة الزمنية

[husain alhammadi]

 

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

ارجوا منكم تعديل الكود UserForm1 الى UserForm100 يتغير حسب مدة الزمنية مكتب امام كل UserForm و يكون مل اشاشة 

Private Sub CommandButton1_Click()
UserForm1.Show.("00:00:30:00")
UserForm2.Show.("00:00:30:00")
UserForm3.Show.("00:00:30:00")
UserForm4.Show.("00:00:30:00")
UserForm5.Show.("00:00:30:00")
UserForm6.Show.("00:00:30:00")
End Sub

111.xlsm

[محمد هشام.]

ادن اخي تفاصيل أخرى يجب ألا تفوتها اثناء تصميمك للملف 

عند إظهار نموذج مستخدم وإخفائه ، يبقى النمودج في الذاكرة ، إذا قمت بالعملية عدة مرات دون تنزيله    ، فقد يكون لديك خطأ في تشبع الذاكرة ،  و توقف البرنامج عن العمل ولهذا السبب من المهم  استخدام  الماكرو التالي:

Sub Unload_Forms()
Dim i As Long, Model As Object
On Error Resume Next
' لنفترض انك لديك 100 يوزر على المصنف
For i = 1 To 100
    Set Model = CallByName(UserForms, "Add", VbMethod, "UserForm" & i)
    Unload Model
   Next
On Error GoTo 0
End Sub

اليك اخي الملف عليه 16 يوزرفورم للتجربة  واختيار ما يناسبك بعد اظافة الاحتمالات الواردة اسفله :

اولا في حالة كنت ترغب بتوحيد وقت الظهور والاخفاء على جميع النمادج يمكنك استخدام الكود التالي 

 

Sub Model_Show()
  Dim i As Long
  Dim Model As Object
  Login_screen.Show   ' نمودج المقدمة
        Application.Wait Now + TimeValue("00:00:5")
        Unload Login_screen

  For i = 1 To 16 '<<<----      ' عدد النمادج المرغوب اظهارها'
    Set Model = CallByName(UserForms, "Add", VbMethod, "UserForm" & i)
   Application.Visible = False
    With Model
    Model.Show
    Model.Repaint
     Application.Wait Now + TimeValue("00:00:2") ' تحديد المدة 
    Model.Hide
    End With
  Next
  ' افراغ الداكرة
On Error Resume Next
  For i = 1 To 16
    Set Model = CallByName(UserForms, "Add", VbMethod, "UserForm" & i)
Unload Model
  Next
  Application.Visible = True
End Sub

الاحتمال رقم 2 وهو الارجح ربما لطلبك 

Option Explicit
Sub View_User1()

Application.Visible = False
On Error Resume Next
        Login_screen.Show
        Application.Wait Now + TimeValue("00:00:12")
        Unload Login_screen
'******************************
        UserForm1.Show
        UserForm1.Repaint
        Application.Wait Now + TimeValue("00:00:5")
        Unload UserForm1
'******************************
      '********* اتمم الكود بنفس الطريقة*********


'******************************
        UserForm16.Show
        UserForm16.Repaint
        Application.Wait Now + TimeValue("00:00:3")
        Unload UserForm16
        
        Application.Visible = True
        
       End
   On Error GoTo 0
 End Sub

 الاحتمال رقم 3 هو انك لا تريد تعديل الكود السابق ادن ما عليك هو جعل الكود بالطريقة التالية 

 

Option Explicit
Sub View_User2()

Application.Visible = False
On Error Resume Next
        Login_screen.Show
        Application.Wait Now + TimeValue("00:00:5")
        Unload Login_screen
'******************************
        UserForm1.Show
        UserForm1.Repaint
        Application.Wait Now + TimeValue("00:00:3")
        UserForm1.Hide

  '*********اتمم الكود بنفس الطريقة*********

'  افراغ الداكرة
   Call Unload_Forms

        Application.Visible = True
        
       End
   On Error GoTo 0
 End Sub

للانتقال بين النمادج قبل نهاية المدة يمكنك الظغط على زر {ESC} /  Échap 

على ما اظن انه الان بين يديك جميع الاحتمالات الواردة لتتمكن من اتمام ملفك وغلق الموضوع بادن الله 

 

 

 

تجربة 3.rar

[محمد هشام.]

حل اخر  يغنيك عن كتابة الاكواد 

في الورقة "الورقة 1" ، ضع أسماء النماذج في العمود A وفي العمود B وقت كل نموذج ، كما هو موضح في المثال التالي:

2)  قم بتشغيل هذا الماكرو: 😁

Sub View_User()
  Dim uForm As Object
  Dim i As Long
  Dim MyRng As Variant
  Dim Nameform As String
  On Error Resume Next
  MyRng = Sheets("Sheet1").Range("A2", Sheets("Sheet1").Range("B" & Rows.Count).End(3))
  Application.Visible = False
  For i = 1 To UBound(MyRng)
    Nameform = MyRng(i, 1)
    Set uForm = CallByName(UserForms, "Add", VbMethod, Nameform)
    DoEvents
    uForm.Show 0
    Application.Wait Now + TimeValue("00:00:" & MyRng(i, 2))
    DoEvents
    Unload uForm
  Next
  Application.Visible = True
  On Error GoTo 0
End Sub

اليك الملف للفائدة 

 

تجربة 4.xlsm

[husain alhammadi]

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

اسال الله رب العرش العظيم ان يزيد في علمك 

فعلا هذا المطلوب انت مبدع بمعنى كلمة جزاك الله خير الجزاء 

استاذى هل يمكن اضافة الصوت 

للعلم سيتم اضافة الصوت للجميع ما عدا Login_screen بدون صوت

اسم نمودج المستخدم	الوقت بالثواني	ملف الصوت
Login_screen	10	
UserForm1	45	C:\Users\husain\OneDrive\سطح المكتب\تجربة\اقامة الصلاة.mp3
UserForm2	10	
UserForm3	51	C:\Users\husain\OneDrive\سطح المكتب\تجربة\سورة الفاتحة.mp3
UserForm4	21	C:\Users\husain\OneDrive\سطح المكتب\تجربة\سورة الاخلاص.mp3
UserForm6	10	
UserForm7	10	
UserForm8	10	
UserForm9	10	
UserForm10	10	
UserForm11	10	
UserForm3	51	C:\Users\husain\OneDrive\سطح المكتب\تجربة\سورة الفاتحة.mp3
UserForm5	33	C:\Users\husain\OneDrive\سطح المكتب\تجربة\سورة الفلق.mp3
UserForm6	10	
UserForm7	10	
UserForm8	10	
UserForm9	10	
UserForm10	10	
UserForm12	10	
UserForm13	10	

تم تعديل نوفمبر 24, 2023 بواسطه husain alhammadi